Hello community,
here is the log from the commit of package ghc-concurrent-output for
openSUSE:Factory checked in at 2017-08-31 20:50:21
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-concurrent-output (Old)
and /work/SRC/openSUSE:Factory/.ghc-concurrent-output.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-concurrent-output"
Thu Aug 31 20:50:21 2017 rev:6 rq:513223 version:1.9.2
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-concurrent-output/ghc-concurrent-output.changes
2017-03-20 17:06:31.447613784 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-concurrent-output.new/ghc-concurrent-output.changes
2017-08-31 20:50:22.478729705 +0200
@@ -1,0 +2,5 @@
+Thu Jul 27 14:08:12 UTC 2017 - [email protected]
+
+- Update to version 1.9.2.
+
+-------------------------------------------------------------------
Old:
----
concurrent-output-1.7.9.tar.gz
New:
----
concurrent-output-1.9.2.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-concurrent-output.spec ++++++
--- /var/tmp/diff_new_pack.uEhzAY/_old 2017-08-31 20:50:23.682560723 +0200
+++ /var/tmp/diff_new_pack.uEhzAY/_new 2017-08-31 20:50:23.694559038 +0200
@@ -18,7 +18,7 @@
%global pkg_name concurrent-output
Name: ghc-%{pkg_name}
-Version: 1.7.9
+Version: 1.9.2
Release: 0
Summary: Ungarble output from several threads or commands
License: BSD-2-Clause
++++++ concurrent-output-1.7.9.tar.gz -> concurrent-output-1.9.2.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/concurrent-output-1.7.9/CHANGELOG
new/concurrent-output-1.9.2/CHANGELOG
--- old/concurrent-output-1.7.9/CHANGELOG 2017-02-12 23:15:31.000000000
+0100
+++ new/concurrent-output-1.9.2/CHANGELOG 2017-05-19 17:37:54.000000000
+0200
@@ -1,3 +1,35 @@
+concurrent-output (1.9.2) unstable; urgency=medium
+
+ * Allow process-1.6.0.0.
+
+ -- Joey Hess <[email protected]> Fri, 19 May 2017 11:36:35 -0400
+
+concurrent-output (1.9.1) unstable; urgency=medium
+
+ * Documentation fix: createProcessConcurrent has been available on
+ Windows since 1.7.5 but the docs said not.
+ * When all regions are closed, flush stdout so that the display gets
+ updated, which didn't happen before.
+
+ -- Joey Hess <[email protected]> Tue, 16 May 2017 16:49:43 -0400
+
+concurrent-output (1.9.0) unstable; urgency=medium
+
+ * Replaced displayUpdateNotifier with a simpler and safer
+ waitDisplayChange interface.
+
+ -- Joey Hess <[email protected]> Fri, 12 May 2017 17:17:09 -0400
+
+concurrent-output (1.8.0) unstable; urgency=medium
+
+ * Added displayUpdateNotifier, which can be used to wait for
+ changes to console regions to be displayed.
+ (stmdemo has an example of using that to temporarily shut down the
+ region based display to run a bash prompt, and restore the region
+ display later.)
+
+ -- Joey Hess <[email protected]> Fri, 12 May 2017 16:27:41 -0400
+
concurrent-output (1.7.9) unstable; urgency=medium
* Allow lazy text to be used as an Outputable value, and as
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/concurrent-output-1.7.9/LICENSE
new/concurrent-output-1.9.2/LICENSE
--- old/concurrent-output-1.7.9/LICENSE 2017-02-12 23:15:31.000000000 +0100
+++ new/concurrent-output-1.9.2/LICENSE 2017-05-19 17:37:54.000000000 +0200
@@ -1,4 +1,4 @@
-Copyright © 2015 Joey Hess <[email protected]>
+Copyright © 2015-2017 Joey Hess <[email protected]>
Copyright © 2009 Joachim Breitner
Redistribution and use in source and binary forms, with or without
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/concurrent-output-1.7.9/System/Console/Concurrent/Internal.hs
new/concurrent-output-1.9.2/System/Console/Concurrent/Internal.hs
--- old/concurrent-output-1.7.9/System/Console/Concurrent/Internal.hs
2017-02-12 23:15:31.000000000 +0100
+++ new/concurrent-output-1.9.2/System/Console/Concurrent/Internal.hs
2017-05-19 17:37:54.000000000 +0200
@@ -147,15 +147,20 @@
-- | Displays a value to stdout.
--
--- No newline is appended to the value, so if you want a newline, be sure
--- to include it yourself.
---
-- Uses locking to ensure that the whole output occurs atomically
-- even when other threads are concurrently generating output.
--
+-- No newline is appended to the value, so if you want a newline, be sure
+-- to include it yourself.
+--
-- When something else is writing to the console at the same time, this does
-- not block. It buffers the value, so it will be displayed once the other
-- writer is done.
+--
+-- When outputConcurrent is used within a call to
+-- `System.Console.Regions.displayConsoleRegions`, the output is displayed
+-- above the currently open console regions. Only lines ending in a newline
+-- are displayed in this case (it uses `waitCompleteLines`).
outputConcurrent :: Outputable v => v -> IO ()
outputConcurrent = outputConcurrent' StdOut
@@ -261,8 +266,6 @@
-- the process is instead run with its stdout and stderr
-- redirected to a buffer. The buffered output will be displayed as soon
-- as the output lock becomes free.
---
--- Currently only available on Unix systems, not Windows.
createProcessConcurrent :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle,
Maybe Handle, ConcurrentProcessHandle)
createProcessConcurrent p
| willOutput (P.std_out p) || willOutput (P.std_err p) =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/concurrent-output-1.7.9/System/Console/Regions.hs
new/concurrent-output-1.9.2/System/Console/Regions.hs
--- old/concurrent-output-1.7.9/System/Console/Regions.hs 2017-02-12
23:15:31.000000000 +0100
+++ new/concurrent-output-1.9.2/System/Console/Regions.hs 2017-05-19
17:37:54.000000000 +0200
@@ -9,7 +9,9 @@
-- License: BSD-2-clause
--
-- Console regions are displayed near the bottom of the console, and can be
--- updated concurrently by threads. Any other output displayed using
+-- updated concurrently by threads.
+--
+-- Any other output lines displayed using
-- `outputConcurrent` and `createProcessConcurrent`
-- will scroll up above the open console regions.
--
@@ -108,6 +110,7 @@
consoleWidth,
consoleHeight,
regionList,
+ waitDisplayChange,
) where
import Data.Monoid
@@ -207,8 +210,7 @@
consoleHeight :: STM Int
consoleHeight = Console.height <$> readTVar consoleSize
--- | The RegionList TMVar is left empty when `displayConsoleRegions`
--- is not running.
+-- | Check if `displayConsoleRegions` is running.
regionDisplayEnabled :: IO Bool
regionDisplayEnabled = atomically $ not <$> isEmptyTMVar regionList
@@ -431,47 +433,93 @@
trackConsoleWidth :: IO ()
trackConsoleWidth = do
- let getwidth = maybe noop (atomically . writeTVar consoleSize)
+ let getsz = maybe noop (atomically . writeTVar consoleSize)
=<< Console.size
- getwidth
- installResizeHandler (Just getwidth)
+ getsz
+ installResizeHandler (Just getsz)
data DisplayChange
- = BufferChange (StdHandle, OutputBuffer)
+ = BufferChange BufferSnapshot
| RegionChange RegionSnapshot
+ | RegionListChange RegionSnapshot
| TerminalResize Width
- | EndSignal ()
+ | Shutdown
+ | DisplayChangeBarrier Barrier
+type BufferSnapshot = (StdHandle, OutputBuffer)
type RegionSnapshot = ([ConsoleRegion], [R], [[Text]])
+type Barrier = Integer
+
+-- | This is a broadcast TChan, which gets a DisplayChange written to it
+-- after the display has been updated. It can be used to wait for something
+-- to be displayed.
+{-# NOINLINE displayUpdateNotifier #-}
+displayUpdateNotifier :: TChan DisplayChange
+displayUpdateNotifier = unsafePerformIO $ newBroadcastTChanIO
+
+{-# NOINLINE displayChangeBarrier #-}
+displayChangeBarrier :: TVar Barrier
+displayChangeBarrier = unsafePerformIO $ newTVarIO 0
+
+-- | Runs a STM action, and waits for the display to be fully updated
+-- before returning.
+waitDisplayChange :: STM a -> IO a
+waitDisplayChange a = do
+ r <- atomically a
+ c <- atomically $ dupTChan displayUpdateNotifier
+ b <- atomically $ do
+ !b <- succ <$> readTVar displayChangeBarrier
+ writeTVar displayChangeBarrier b
+ return b
+ atomically $ waitchange c b
+ return r
+ where
+ waitchange c b = do
+ change <- readTChan c
+ case change of
+ DisplayChangeBarrier b' | b' == b -> return ()
+ _ -> waitchange c b
displayThread :: Bool -> TSem -> IO ()
displayThread isterm endsignal = do
origwidth <- atomically consoleWidth
- go ([], [], []) origwidth
+ origbarrier <- atomically (readTVar displayChangeBarrier)
+ go ([], [], []) origwidth origbarrier
where
- go origsnapshot@(orighandles, origregions, origlines) origwidth = do
+ go origsnapshot@(orighandles, origregions, origlines) origwidth
origbarrier = do
let waitwidthchange = do
w <- consoleWidth
if w == origwidth then retry else return w
+ let waitbarrierchange = do
+ b <- readTVar displayChangeBarrier
+ if b /= origbarrier
+ then return b
+ else retry
let waitanychange =
(RegionChange <$> regionWaiter origsnapshot origwidth)
`orElse`
- (RegionChange <$> regionListWaiter origsnapshot)
+ (RegionListChange <$> regionListWaiter origsnapshot)
`orElse`
(BufferChange <$> outputBufferWaiterSTM
waitCompleteLines)
`orElse`
(TerminalResize <$> waitwidthchange)
`orElse`
- (EndSignal <$> waitTSem endsignal)
+ (waitTSem endsignal >> pure Shutdown)
+ `orElse`
+ -- Must come last, so the changes above are
+ -- processed before barriers.
+ (DisplayChangeBarrier <$> waitbarrierchange)
(change, height) <- atomically $ (,)
<$> waitanychange
<*> consoleHeight
let onscreen = take (height - 1) . concat
- case change of
- RegionChange snapshot@(_, _, newlines) -> do
- when isterm $ do
- changedLines (onscreen origlines)
(onscreen newlines)
- go snapshot origwidth
+ let update snapshot@(_, _, newlines) = do
+ when isterm $
+ changedLines (onscreen origlines) (onscreen
newlines)
+ return $ go snapshot origwidth origbarrier
+ next <- case change of
+ RegionChange snapshot -> update snapshot
+ RegionListChange snapshot -> update snapshot
BufferChange (h, buf) -> do
-- Note that even when every available line
-- is dedicated to visible regions, the
@@ -481,13 +529,19 @@
let origlines' = onscreen origlines
inAreaAbove isterm (length origlines')
origlines' $
emitOutputBuffer h buf
- go origsnapshot origwidth
+ return $ go origsnapshot origwidth origbarrier
TerminalResize newwidth -> do
newlines <- atomically (mapM (resizeRegion
newwidth) orighandles)
when isterm $ do
resizeRecovery (onscreen newlines)
- go (orighandles, origregions, newlines) newwidth
- EndSignal () -> return ()
+ return $ go (orighandles, origregions,
newlines) newwidth origbarrier
+ Shutdown ->
+ return $ return ()
+ DisplayChangeBarrier b ->
+ return $ go origsnapshot origwidth b
+ hFlush stdout
+ atomically $ writeTChan displayUpdateNotifier change
+ next
readRegions :: [ConsoleRegion] -> STM [R]
readRegions = mapM (\(ConsoleRegion h) -> readTVar h)
@@ -576,7 +630,6 @@
#endif
cursorDown (sum (map (snd . fst) l'))
setCursorColumn 0
- hFlush stdout
where
l' = changeOffsets l 1 []
@@ -608,7 +661,6 @@
when isterm $ do
setCursorColumn 0 -- just in case the output lacked a newline
displayLines (reverse ls)
- hFlush stdout
displayLines :: [Text] -> IO ()
displayLines = mapM_ $ \l -> do
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/concurrent-output-1.7.9/concurrent-output.cabal
new/concurrent-output-1.9.2/concurrent-output.cabal
--- old/concurrent-output-1.7.9/concurrent-output.cabal 2017-02-12
23:15:31.000000000 +0100
+++ new/concurrent-output-1.9.2/concurrent-output.cabal 2017-05-19
17:37:54.000000000 +0200
@@ -1,11 +1,11 @@
Name: concurrent-output
-Version: 1.7.9
+Version: 1.9.2
Cabal-Version: >= 1.8
License: BSD2
Maintainer: Joey Hess <[email protected]>
Author: Joey Hess, Joachim Breitner
Stability: Stable
-Copyright: 2015 Joey Hess, 2009 Joachim Breitner
+Copyright: 2015-2017 Joey Hess, 2009 Joachim Breitner
License-File: LICENSE
Build-Type: Simple
Category: User Interfaces
@@ -34,7 +34,7 @@
, text (>= 0.11.0 && < 1.3.0)
, async (>= 2.0 && < 2.2)
, stm (>= 2.0 && < 2.5)
- , process (>= 1.1.0 && < 1.5.0)
+ , process (>= 1.1.0 && < 1.7.0)
, directory (>= 1.2.0 && < 1.4.0)
, transformers (>= 0.3.0 && < 0.6.0)
, exceptions (>= 0.6.0 && < 0.9.0)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/concurrent-output-1.7.9/stmdemo.hs
new/concurrent-output-1.9.2/stmdemo.hs
--- old/concurrent-output-1.7.9/stmdemo.hs 2017-02-12 23:15:31.000000000
+0100
+++ new/concurrent-output-1.9.2/stmdemo.hs 2017-05-19 17:37:54.000000000
+0200
@@ -7,15 +7,25 @@
import Data.Time.Clock
import Control.Monad
import Data.Monoid
+import System.Process
main :: IO ()
main = void $ displayConsoleRegions $ do
+ void titleRegion
ir <- infoRegion
cr <- clockRegion
rr <- rulerRegion
growingDots
+ runBash
+ growingDots
mapM_ closeConsoleRegion [ir, cr]
+titleRegion :: IO ConsoleRegion
+titleRegion = do
+ r <- openConsoleRegion Linear
+ setConsoleRegion r "STM demo!"
+ return r
+
infoRegion :: IO ConsoleRegion
infoRegion = do
r <- openConsoleRegion Linear
@@ -48,24 +58,34 @@
rightAlign r
return r
+rulerRegion :: IO ConsoleRegion
+rulerRegion = do
+ r <- openConsoleRegion Linear
+ setConsoleRegion r $ do
+ width <- consoleWidth
+ return $ T.pack $ take width nums
+ return r
+ where
+ nums = cycle $ concatMap show [0..9]
+
rightAlign :: ConsoleRegion -> STM ()
rightAlign r = tuneDisplay r $ \t -> do
w <- consoleWidth
return (T.replicate (w - T.length t) (T.singleton ' ') <> t)
+growingDots :: IO ()
growingDots = withConsoleRegion Linear $ \r -> do
atomically $ rightAlign r
width <- atomically consoleWidth
- replicateM width $ do
+ void $ replicateM width $ do
appendConsoleRegion r "."
threadDelay (100000)
-rulerRegion :: IO ConsoleRegion
-rulerRegion = do
- r <- openConsoleRegion Linear
- setConsoleRegion r $ do
- width <- consoleWidth
- return $ T.pack $ take width nums
- return r
- where
- nums = cycle $ concatMap show [0..9]
+runBash :: IO ()
+runBash = do
+ -- Temporarily clear whatever console regions are open.
+ rs <- waitDisplayChange $ swapTMVar regionList []
+ putStrLn "We interrupt this demo to run a shell prompt. exit to
continue!"
+ callCommand "bash"
+ -- Restore the console regions.
+ void $ atomically $ swapTMVar regionList rs
