packages feed

concurrent-output 1.10.11 → 1.10.12

raw patch · 9 files changed

+65/−88 lines, 9 filesdep ~ansi-terminalPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ansi-terminal

API changes (from Hackage documentation)

Files

CHANGELOG view
@@ -1,3 +1,18 @@+concurrent-output (1.10.12) unstable; urgency=medium++  * Bugfix: createProcessConcurrent would sometimes send the process's+    output to the console when it was supposed to be piped to a handle.+    (1.7.5 introduced this bug)+  * System.Console.Regions should be safe to use in a thread that+    receives async exceptions; displayConsoleRegions and withConsoleRegion+    have been made async exception safe.+    (However, System.Console.Concurrent is not async exception safe.)+  * Improve documentation about when withConcurrentOutput should be used.+  * Remove some unused code.+  * Allow building with older ansi-terminal versions, not only 0.9+.++ -- Joey Hess <id@joeyh.name>  Wed, 10 Jun 2020 17:22:39 -0400+ concurrent-output (1.10.11) unstable; urgency=medium    * Improve documentation of how to use ANSI color codes.
System/Console/Concurrent.hs view
@@ -7,7 +7,7 @@ -- > import Control.Concurrent.Async -- > import System.Console.Concurrent -- >--- > main = withConcurrentOutput $+-- > main = withConcurrentOutput $ do -- > 	outputConcurrent "washed the car\n" -- > 		`concurrently` -- >	outputConcurrent "walked the dog\n"
System/Console/Concurrent/Internal.hs view
@@ -102,7 +102,8 @@ dropOutputLock = withLock $ void . takeTMVar  -- | Use this around any actions that use `outputConcurrent`--- or `createProcessConcurrent`+-- or `createProcessConcurrent`, unless +-- `System.Console.Regions.displayConsoleRegions` is being used. -- -- This is necessary to ensure that buffered concurrent output actually -- gets displayed before the program exits.@@ -264,14 +265,17 @@ 	-- Wait for the process for symmetry with fgProcess, 	-- which does the same. 	_ <- async $ void $ tryIO $ P.waitForProcess h-	outbuf <- setupOutputBuffer StdOut stdout_h-	errbuf <- setupOutputBuffer StdErr stderr_h+	outbuf <- setupOutputBuffer StdOut (mungebuf (P.std_out p) stdout_h)+	errbuf <- setupOutputBuffer StdErr (mungebuf (P.std_err p) stderr_h) 	void $ async $ bufferWriter [outbuf, errbuf] 	return r   where 	rediroutput ss 		| willOutput ss = P.CreatePipe 		| otherwise = ss+	mungebuf ss mh+		| willOutput ss = mh+		| otherwise = Nothing 	mungeret ss mh 		| willOutput ss = Nothing 		| otherwise = mh
System/Console/Regions.hs view
@@ -145,6 +145,7 @@ -- | Controls how a region is laid out in the console. -- -- Here's an annotated example of how the console layout works.+-- Each sequence of the same letter represents a distinct region. -- -- > scrolling...... -- > scrolling......@@ -311,7 +312,9 @@ -- | Runs the action with a new console region, closing the region when -- the action finishes or on exception. withConsoleRegion :: (MonadIO m, MonadMask m) => RegionLayout -> (ConsoleRegion -> m a) -> m a-withConsoleRegion ly = bracketIO (openConsoleRegion ly) (closeConsoleRegion)+withConsoleRegion ly = bracketIO+	(openConsoleRegion ly)+	(uninterruptibleMask_ . closeConsoleRegion)  -- | Opens a new console region. openConsoleRegion :: LiftRegion m => RegionLayout -> m ConsoleRegion@@ -420,7 +423,9 @@ -- Note that this uses `lockOutput`, so it takes over all output to the -- console while the passed IO action is running. As well as displaying -- the console regions, this handles display of anything buffered by--- `outputConcurrent` and `createProcessConcurrent`.+-- `outputConcurrent` and `createProcessConcurrent`. So,+-- `withConcurrentOutput` and `flushConcurrentOutput` should not be run+-- while this is in use, and will block. -- -- When standard output is not an ANSI capable terminal, -- console regions are not displayed.@@ -430,17 +435,17 @@ 	, lockOutput $ bracket setup cleanup (const a) 	)   where-	setup = liftIO $ do+	setup = liftIO $ uninterruptibleMask $ \unmask -> do 		atomically $ putTMVar regionList [] 		endsignal <- atomically $ do 			s <- newTSem 1 			waitTSem s 			return s 		isterm <- liftIO $ hSupportsANSI stdout-		when isterm trackConsoleWidth-		da <- async $ displayThread isterm endsignal+		when isterm (unmask trackConsoleWidth)+		da <- async $ unmask $ displayThread isterm endsignal 		return (isterm, da, endsignal)-	cleanup (isterm, da, endsignal) = liftIO $ do+	cleanup (isterm, da, endsignal) = liftIO $ uninterruptibleMask_ $ do 		atomically $ signalTSem endsignal 		void $ wait da 		void $ atomically $ takeTMVar regionList
TODO view
@@ -0,0 +1,25 @@+* Parts of System.Console.Concurrent may not be async exception safe.++  If a thread is running an action from that module and an async exception+  is sent to it, it may result in a deadlock or other problem.++  (System.Console.Regions has been made safe.)++* Calling setConsoleRegion with something that throws an error+  will cause no further display updates to happen.+  +  The exception in the thunk will crash the displayThread,+  and that is not waited on until the action passed to displayConsoleRegions+  finishes, so the exception is deferred to that point. Of course if the+  action never finishes, that hides the exception.++  It does seem this should be improved, by catching the crashing+  displayThread and ideally propigating the exception immediately.+  But displayConsoleRegions would need to use a different class than+  the current MonadIO to be able to do that. Eg, MonadBaseControl+  so lifted-async can be used, or a class that lets the action be+  canceled.++  Or it could be dealt with by having setConsoleRegion force the thunk+  before passing it over to the displayThread. But the instance+  ToRegionContent (STM Text) seems to prevent doing that.
− Utility/Data.hs 
@@ -1,19 +0,0 @@-{- utilities for simple data types- -- - Copyright 2013 Joey Hess <id@joeyh.name>- -- - License: BSD-2-clause- -}--{-# OPTIONS_GHC -fno-warn-tabs #-}--module Utility.Data where--{- First item in the list that is not Nothing. -}-firstJust :: Eq a => [Maybe a] -> Maybe a-firstJust ms = case dropWhile (== Nothing) ms of-	[] -> Nothing-	(md:_) -> md--eitherToMaybe :: Either a b -> Maybe b-eitherToMaybe = either (const Nothing) Just
Utility/Exception.hs view
@@ -31,8 +31,6 @@ import System.IO.Error (isDoesNotExistError, ioeGetErrorType) import GHC.IO.Exception (IOErrorType(..)) -import Utility.Data- {- Catches IO errors and returns a Bool -} catchBoolIO :: MonadCatch m => m Bool -> m Bool catchBoolIO = catchDefaultIO False@@ -86,7 +84,7 @@ tryWhenExists :: MonadCatch m => m a -> m (Maybe a) tryWhenExists a = do 	v <- tryJust (guard . isDoesNotExistError) a-	return (eitherToMaybe v)+	return (either (const Nothing) Just v)  {- Catches only exceptions caused by hardware faults.  - Ie, disk IO error. -}
Utility/Monad.hs view
@@ -9,62 +9,11 @@  module Utility.Monad where -import Data.Maybe-import Control.Monad--{- Return the first value from a list, if any, satisfying the given- - predicate -}-firstM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)-firstM _ [] = return Nothing-firstM p (x:xs) = ifM (p x) (return $ Just x , firstM p xs)--{- Runs the action on values from the list until it succeeds, returning- - its result. -}-getM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)-getM _ [] = return Nothing-getM p (x:xs) = maybe (getM p xs) (return . Just) =<< p x--{- Returns true if any value in the list satisfies the predicate,- - stopping once one is found. -}-anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool-anyM p = liftM isJust . firstM p--allM :: Monad m => (a -> m Bool) -> [a] -> m Bool-allM _ [] = return True-allM p (x:xs) = p x <&&> allM p xs--{- Runs an action on values from a list until it succeeds. -}-untilTrue :: Monad m => [a] -> (a -> m Bool) -> m Bool-untilTrue = flip anyM- {- if with a monadic conditional. -} ifM :: Monad m => m Bool -> (m a, m a) -> m a ifM cond (thenclause, elseclause) = do 	c <- cond 	if c then thenclause else elseclause--{- short-circuiting monadic || -}-(<||>) :: Monad m => m Bool -> m Bool -> m Bool-ma <||> mb = ifM ma ( return True , mb )--{- short-circuiting monadic && -}-(<&&>) :: Monad m => m Bool -> m Bool -> m Bool-ma <&&> mb = ifM ma ( mb , return False )--{- Same fixity as && and || -}-infixr 3 <&&>-infixr 2 <||>--{- Runs an action, passing its value to an observer before returning it. -}-observe :: Monad m => (a -> m b) -> m a -> m a-observe observer a = do-	r <- a-	_ <- observer r-	return r--{- b `after` a runs first a, then b, and returns the value of a -}-after :: Monad m => m b -> m a -> m a-after = observe . const  {- do nothing -} noop :: Monad m => m ()
concurrent-output.cabal view
@@ -1,11 +1,11 @@ Name: concurrent-output-Version: 1.10.11-Cabal-Version: >= 1.8+Version: 1.10.12+Cabal-Version: >= 1.10 License: BSD2 Maintainer: Joey Hess <id@joeyh.name> Author: Joey Hess, Joachim Breitner Stability: Stable-Copyright: 2015-2017 Joey Hess, 2009 Joachim Breitner+Copyright: 2015-2020 Joey Hess, 2009 Joachim Breitner License-File: LICENSE Build-Type: Simple Category: User Interfaces@@ -29,6 +29,7 @@   stmdemo.hs  Library+  Default-Language: Haskell98   GHC-Options: -Wall -fno-warn-tabs -O2   Build-Depends: base (>= 4.6), base < 5     , text (>= 0.11.0 && < 1.3.0)@@ -38,7 +39,7 @@     , directory (>= 1.2.0 && < 1.4.0)     , transformers (>= 0.3.0 && < 0.6.0)     , exceptions (>= 0.6.0 && < 0.11.0)-    , ansi-terminal (>= 0.9.1 && < 0.11.0)+    , ansi-terminal (>= 0.6.0 && < 0.11.0)     , terminal-size (>= 0.3.0 && < 0.4.0)   Exposed-Modules:     System.Console.Concurrent@@ -47,7 +48,6 @@     System.Process.Concurrent   Other-Modules:     Utility.Monad-    Utility.Data     Utility.Exception    if (! os(Windows))