packages feed

process-progress 0.9 → 0.14

raw patch · 10 files changed

+151/−584 lines, 10 filesdep ~process-listlikesetup-changed

Dependency ranges changed: process-listlike

Files

Setup.hs view
@@ -1,20 +1,9 @@ import Distribution.Simple import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(buildDir)) import Distribution.Simple.Program-import System.Cmd import System.Directory import System.Exit+import System.Process  main = copyFile "debian/changelog" "changelog" >>-       defaultMainWithHooks simpleUserHooks {-         postBuild =-             \ _ _ _ lbi ->-                 case buildDir lbi of-                   "dist-ghc/build" -> return ()-                   _ -> runTestScript lbi-       , runTests = \ _ _ _ lbi -> runTestScript lbi-       }--runTestScript lbi =-    system (buildDir lbi ++ "/tests/tests") >>= \ code ->-    if code == ExitSuccess then return () else error "unit test failure"+       defaultMainWithHooks simpleUserHooks
System/Process/Progress.hs view
@@ -3,15 +3,11 @@ {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Progress-    ( module System.Process.Read.Chunks+    ( module System.Process.Read.Convenience     , module System.Process.Read.Compat     , module System.Process.Read.Monad-    , module System.Process.Read.Verbosity-    , module System.Process.Read.Convenience     ) where -import System.Process.Read.Chunks import System.Process.Read.Convenience import System.Process.Read.Compat import System.Process.Read.Monad-import System.Process.Read.Verbosity
− System/Process/Read/Chunks.hs 
@@ -1,294 +0,0 @@--- | The 'readProcessChunks' function is a process reader that returns--- a list (stream) of 'Output', which represent chunks of text read--- from 'Stdout', 'Stderr', a 'Result' code, or an 'Exception'.  This--- has the advantage of preserving the order in which these things--- appeared.  The 'foldOutput', 'foldOutputsL', and 'foldOutputsR'--- functions can be used to process the output stream.  The output--- text can be any 'NonBlocking' instance, which needs to be implemented--- using a non-blocking read function like 'B.hGetSome'.--{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances #-}-module System.Process.Read.Chunks (-  NonBlocking(..),-  Output(..),-  foldOutput,-  foldOutputsL,-  foldOutputsR,-  readProcessChunks,-  readProcessChunks'-  ) where--import Control.Applicative ((<$>))-import Control.Concurrent (forkIO, threadDelay, MVar, newEmptyMVar, putMVar, takeMVar)-import Control.DeepSeq (NFData)-import Control.Exception as E (onException, catch, mask, try, throwIO, SomeException)-import Control.Monad (unless)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import Data.ListLike (ListLike(..), ListLikeIO(..))-import Data.Word (Word8)-import qualified GHC.IO.Exception as E-import GHC.IO.Exception (IOErrorType(ResourceVanished), IOException(ioe_type))-import Prelude hiding (null, length, rem)-import qualified Prelude-import System.Exit (ExitCode)-import System.IO hiding (hPutStr, hGetContents)-import System.IO.Error (mkIOError)-import System.Process.Read (ListLikePlus(..))-import System.IO.Unsafe (unsafeInterleaveIO)-import System.Process (CreateProcess(..), StdStream(CreatePipe), ProcessHandle,-                       createProcess, waitForProcess, terminateProcess)---- | This lets us use deepseq's force on the stream of data returned--- by the process-progress functions.-instance NFData ExitCode---- | Class of types which can also be used by 'System.Process.Read.readProcessChunks'.-class ListLikePlus a c => NonBlocking a c where-  hGetSome :: Handle -> LengthType a -> IO a-  toChunks :: a -> [a]--data Output a = Stdout a | Stderr a | Result ExitCode | Exception IOError deriving (Eq, Show)---- | A fold function for the Output type, dispatches the value--- depending on the constructor.-foldOutput :: ListLikePlus a c =>-              (ExitCode -> b)-           -> (a -> b)-           -> (a -> b)-           -> (IOError -> b)-           -> Output a-           -> b-foldOutput codefn _ _ _ (Result code) = codefn code-foldOutput _ outfn _ _ (Stdout out) = outfn out-foldOutput _ _ errfn _ (Stderr err) = errfn err-foldOutput _ _ _ exnfn (Exception exn) = exnfn exn--foldOutputsL :: ListLikePlus a c =>-                (b -> ExitCode -> b)-             -> (b -> a -> b)-             -> (b -> a -> b)-             -> (b -> IOError -> b)-             -> b-             -> [Output a]-             -> b-foldOutputsL _ _ _ _ result [] = result-foldOutputsL codefn outfn errfn exnfn result (x : xs) =-    let result' = foldOutput (codefn result) (outfn result) (errfn result) (exnfn result) x in-    foldOutputsL codefn outfn errfn exnfn result' xs-    -- Pretty sure this is equivalent:-    -- foldl (\ r x -> foldOutput (codefn r) (outfn r) (errfn r) (exnfn r) x) result xs--foldOutputsR :: forall a b c. ListLikePlus a c =>-                (b -> ExitCode -> b)-             -> (b -> a -> b)-             -> (b -> a -> b)-             -> (b -> IOError -> b)-             -> b-             -> [Output a]-             -> b-foldOutputsR _ _ _ _ result [] = result-foldOutputsR codefn outfn errfn exnfn result (x : xs) =-    let result' = foldOutputsR codefn outfn errfn exnfn result xs in-    foldOutput (codefn result') (outfn result') (errfn result') (exnfn result') x-    -- foldr (\ x r -> foldOutput (codefn r) (outfn r) (errfn r) (exnfn r) x) result xs---- | This is a process runner which (at the cost of a busy loop) gives--- you the chunks of text read from stdout and stderr interleaved in--- the order they were written, along with any ResourceVanished--- exxception that might occur.  Its interface is similar to--- 'System.Process.Read.readModifiedProcessWith', though the--- implementation is somewhat alarming.-readProcessChunks :: (NonBlocking a c) =>-                     CreateProcess-                  -> a-                  -> IO [Output a]-readProcessChunks p input = mask $ \ restore -> do-  (Just inh, Just outh, Just errh, pid) <--      createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe })--  binary input [inh, outh, errh]--  flip onException-    (do hClose inh; hClose outh; hClose errh;-        terminateProcess pid; waitForProcess pid) $ restore $ do--    waitOut <- forkWait $ elements pid (Just outh) (Just errh)--    -- now write and flush any input-    (do unless (null input) (hPutStr inh input >> hFlush inh)-        hClose inh) `E.catch` resourceVanished (\ _e -> return ())--    -- wait on the output-    waitOut---- | Take the info returned by 'createProcess' and gather and return--- the stdout and stderr of the process.-elements :: NonBlocking a c => ProcessHandle -> Maybe Handle -> Maybe Handle -> IO [Output a]-elements pid outh errh =-    do case (outh, errh) of-         (Nothing, Nothing) ->-           -- EOF on both output descriptors, get exit code.  It can be-           -- argued that the result will always contain exactly one exit-           -- code if traversed to its end, because the only case of-           -- 'elements' that does not recurse is the one that adds a Result,-           -- and there is nowhere else where a Result is added.  However,-           -- the process doing the traversing may die before that end is-           -- reached.-           do result <- waitForProcess pid-              return [Result result]-         _ ->-           -- The available output has been processed, send input and read-           -- from the ready handles-           do (outh', errh', elems') <- ready uSecs outh errh-              more <- unsafeInterleaveIO (elements pid outh' errh')-              return $ elems' ++ more--data Readyness = Ready | Unready | Closed--hReady' :: Handle -> IO Readyness-hReady' h =-    -- This check is necessary because if we run hReady on a closed-    -- handle it will keep giving us EOF exceptions.-    hIsClosed h >>= checkReady-    where-      checkReady True = return Closed-      checkReady False =-          (hReady h >>= (\ flag -> return (if flag then Ready else Unready)))-            `catch` endOfFile (\ _ -> return Closed)---- | Wait until at least one handle is ready and then read output.  If--- none of the output descriptors are ready for reading the function--- sleeps and tries again.-ready :: (NonBlocking a c) =>-         Int -> Maybe Handle -> Maybe Handle-      -> IO (Maybe Handle, Maybe Handle, [Output a])-ready waitUSecs outh errh =-    do-      outReady <- maybe (return Closed) hReady' outh-      errReady <- maybe (return Closed) hReady' errh-      case (outReady, errReady) of-        (Closed, Closed) ->-            return (Nothing, Nothing, [])-        -- Input handle closed and there are no ready output handles,-        -- wait a bit-        (Unready, Unready) ->-            do threadDelay waitUSecs-               ready (min maxUSecs (2 * waitUSecs)) outh errh-        _ ->-            -- One or both output handles are ready, try to read from-            -- them.  If (out1 ++ out2) is an empty list we know that-            -- we have reached EOF on both descriptors, because at-            -- least one was ready and nextOut only returns [] for a-            -- ready file descriptor on EOF.-            do (errh', out1) <- nextOut errh errReady Stderr-               (outh', out2) <- nextOut outh outReady Stdout-               return (outh', errh', out1 ++ out2)---- | Return the next output element and the updated handle from a--- handle which is assumed ready.  If the handle is closed or unready,--- or we reach end of file an empty list of outputs is returned.-nextOut :: NonBlocking a c => Maybe Handle -> Readyness -> (a -> Output a) -> IO (Maybe Handle, [Output a])-nextOut Nothing _ _ = return (Nothing, [])-nextOut (Just h) Ready constructor =	-- Perform a read-   do -- We can call hGetSome because we know this handle is ready for reading.-      a <- hGetSome h (fromIntegral bufSize)-      case length a of-        -- A zero length read, unlike a zero length write, always-        -- means EOF.-        0 -> do hClose h-                return (Nothing, [])-        -- Got some output-        _n -> return (Just h, [constructor a])-nextOut h _ _ = return (h, [])	-- Handle is closed or not ready--endOfFile :: (IOError -> IO a) -> IOError -> IO a-endOfFile eeof e = if E.ioe_type e == E.EOF then eeof e else ioError e--bufSize :: Int-bufSize = 4096		-- maximum chunk size-uSecs :: Int-uSecs = 8		-- minimum wait time, doubles each time nothing is ready-maxUSecs :: Int-maxUSecs = 100000	-- maximum wait time (microseconds)---- | A test version of readProcessChunks.--- Pipes code here: http://hpaste.org/76631-readProcessChunks' :: (NonBlocking a c) =>-                      CreateProcess-                   -> a-                   -> IO [Output a]-readProcessChunks' p input = mask $ \ restore -> do-  (Just inh, Just outh, Just errh, pid) <--      createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe })--  binary input [inh, outh, errh]--  flip onException-    (do hClose inh; hClose outh; hClose errh;-        terminateProcess pid; waitForProcess pid) $ restore $ do--    waitOut <- forkWait $ elements' pid outh errh--    -- now write and flush any input-    (do unless (null input) (hPutStr inh input >> hFlush inh)-        hClose inh) `catch` resourceVanished (\ _e -> return ())--    -- wait on the output-    waitOut---- | An idea for a replacement of elements-elements' :: forall a c. NonBlocking a c => ProcessHandle -> Handle -> Handle -> IO [Output a]-elements' pid outh errh = do-  res <- newEmptyMVar-  -- We use Exception EOF to indicate that we reached EOF on one-  -- handle.  This is not a value that could otherwise have been put-  -- into the MVar.-  _outtid <- forkIO $ hGetContents outh >>= mapM_ (\ c -> putMVar res (Stdout c)) . toChunks >> hClose outh >> putMVar res (Exception (mkIOError E.EOF "EOF" Nothing Nothing))-  _errtid <- forkIO $ hGetContents errh >>= mapM_ (\ c -> putMVar res (Stderr c)) . toChunks >> hClose errh >> putMVar res (Exception (mkIOError E.EOF "EOF" Nothing Nothing))-  takeChunks 0 res-    where-      takeChunks :: Int -> MVar (Output a) -> IO [Output a]-      takeChunks 2 _ = waitForProcess pid >>= \ result -> return [Result result]-      takeChunks closedCount res = takeMVar res >>= takeChunk closedCount res-      takeChunk closedCount res (Exception _) = takeChunks (closedCount + 1) res-      takeChunk closedCount res x =-          do xs <- unsafeInterleaveIO $ takeChunks closedCount res-             return (x : xs)--forkWait :: IO a -> IO (IO a)-forkWait a = do-  res <- newEmptyMVar-  _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res-  return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)---- | Wrapper for a process that provides a handler for the--- ResourceVanished exception.  This is frequently an exception we--- wish to ignore, because many processes will deliberately exit--- before they have read all of their input.-resourceVanished :: (IOError -> IO a) -> IOError -> IO a-resourceVanished epipe e = if ioe_type e == ResourceVanished then epipe e else ioError e--{--proc' :: CmdSpec -> CreateProcess-proc' (RawCommand cmd args) = proc cmd args-proc' (ShellCommand cmd) = shell cmd--}--{- Its not safe to read a bytestring chunk and then convert it to a string, the chunk-   might end with part of a character.-instance NonBlocking String Char where-  -- hGetNonBlocking n h = (toString . B.concat . L.toChunks) <$> L.hGetNonBlocking n h-  hGetSome h n = toList <$> B.hGetSome h n-  toChunks = error "toChunks"--}--instance NonBlocking B.ByteString Word8 where-  -- hGetNonBlocking = B.hGetNonBlocking-  hGetSome = B.hGetSome-  toChunks = (: [])--instance NonBlocking L.ByteString Word8 where-  -- hGetNonBlocking = L.hGetNonBlocking-  hGetSome h n = (L.fromChunks . (: [])) <$> B.hGetSome h (fromIntegral n)-  toChunks = Prelude.map (L.fromChunks . (: [])) . L.toChunks
System/Process/Read/Compat.hs view
@@ -10,9 +10,9 @@ import Data.Time (NominalDiffTime, getCurrentTime, diffUTCTime) import System.Exit (ExitCode(..)) import System.Process (CmdSpec(..), showCommandForUser)-import System.Process.Read.Chars (ListLikePlus)+import System.Process.Chunks (Chunk(..))+import System.Process.ListLike (ListLikePlus) import System.Process.Read.Convenience (ePutStrLn, keepResult)-import System.Process.Read.Chunks (Output(..))  -- | Output a description of a command and then run it. echo :: CmdSpec -> IO () -> IO ()@@ -21,7 +21,7 @@  -- | Extract the result code of an output stream, throw an error if -- there isn't exactly one of them.-oneResult :: ListLikePlus a c => [Output a] -> ExitCode+oneResult :: ListLikePlus a c => [Chunk a] -> ExitCode oneResult xs =     case keepResult xs of       [code] -> code
System/Process/Read/Convenience.hs view
@@ -7,6 +7,7 @@     , isStderr     , isOutput     , isException+    , isHandle     -- * Filters     , discardStdout     , discardStderr@@ -54,7 +55,6 @@     ) where  import Control.Exception (throw)-import Control.Monad (when) import Control.Monad.Trans (MonadIO, liftIO) import Data.ListLike (ListLike(empty, append, concat, span, tail, singleton, null), ListLikeIO(hPutStr)) import Data.Maybe (mapMaybe)@@ -62,68 +62,72 @@ import System.Exit (ExitCode(..), exitWith) import System.IO (stdout, stderr) import qualified System.IO as IO (hPutStr, hPutStrLn)-import System.Process.Read.Chars (ListLikePlus(..))-import System.Process.Read.Chunks (NonBlocking(..), Output(..), foldOutput, foldOutputsR)-import System.Process.Read.Instances ()+import System.Process (ProcessHandle)+import System.Process.ListLike (ListLikePlus(..))+import System.Process.Chunks (Chunk(..), foldChunks, foldChunk, putDots) -isResult :: ListLikePlus a c => Output a -> Bool-isResult = foldOutput (const True) (const False) (const False) (const False)-isStdout :: ListLikePlus a c => Output a -> Bool-isStdout = foldOutput (const False) (const True) (const False) (const False)-isStderr :: ListLikePlus a c => Output a -> Bool-isStderr = foldOutput (const False) (const False) (const True) (const False)-isOutput :: ListLikePlus a c => Output a -> Bool-isOutput = foldOutput (const False) (const True) (const True) (const False)-isException :: ListLikePlus a c => Output a -> Bool-isException = foldOutput (const False) (const False) (const False) (const True)+isHandle :: ListLikePlus a c => Chunk a -> Bool+isHandle = foldChunk (const True) (const False) (const False) (const False) (const False)+isResult :: ListLikePlus a c => Chunk a -> Bool+isResult = foldChunk (const False) (const False) (const False) (const False) (const True)+isStdout :: ListLikePlus a c => Chunk a -> Bool+isStdout = foldChunk (const False) (const True) (const False) (const False) (const False)+isStderr :: ListLikePlus a c => Chunk a -> Bool+isStderr = foldChunk (const False) (const False) (const True) (const False) (const False)+isOutput :: ListLikePlus a c => Chunk a -> Bool+isOutput = foldChunk (const False) (const True) (const True) (const False) (const False)+isException :: ListLikePlus a c => Chunk a -> Bool+isException = foldChunk (const False) (const False) (const False) (const True) (const False) -toStdout :: ListLikePlus a c => Output a -> Output a-toStdout = foldOutput Result Stdout Stdout Exception-toStderr :: ListLikePlus a c => Output a -> Output a-toStderr = foldOutput Result Stderr Stderr Exception+toStdout :: ListLikePlus a c => Chunk a -> Chunk a+toStdout = foldChunk ProcessHandle Stdout Stdout Exception Result+toStderr :: ListLikePlus a c => Chunk a -> Chunk a+toStderr = foldChunk ProcessHandle Stderr Stderr Exception Result -mergeToStdout :: ListLikePlus a c => [Output a] -> [Output a]+mergeToStdout :: ListLikePlus a c => [Chunk a] -> [Chunk a] mergeToStdout = map toStdout-mergeToStderr :: ListLikePlus a c => [Output a] -> [Output a]+mergeToStderr :: ListLikePlus a c => [Chunk a] -> [Chunk a] mergeToStderr = map toStderr -discardStdout :: ListLikePlus a c => [Output a] -> [Output a]+discardStdout :: ListLikePlus a c => [Chunk a] -> [Chunk a] discardStdout = filter (not . isStdout)-discardStderr :: ListLikePlus a c => [Output a] -> [Output a]+discardStderr :: ListLikePlus a c => [Chunk a] -> [Chunk a] discardStderr = filter (not . isStderr)-discardOutput :: ListLikePlus a c => [Output a] -> [Output a]+discardOutput :: ListLikePlus a c => [Chunk a] -> [Chunk a] discardOutput = filter (\ x -> not (isStdout x || isStderr x))-discardExceptions :: ListLikePlus a c => [Output a] -> [Output a]+discardExceptions :: ListLikePlus a c => [Chunk a] -> [Chunk a] discardExceptions = filter (not . isException)-discardResult :: ListLikePlus a c => [Output a] -> [Output a]+discardResult :: ListLikePlus a c => [Chunk a] -> [Chunk a] discardResult = filter (not . isResult) -keepStdout :: ListLikePlus a c => [Output a] -> [a]-keepStdout = mapMaybe $ foldOutput (const Nothing) Just (const Nothing) (const Nothing)-keepStderr :: ListLikePlus a c => [Output a] -> [a]-keepStderr = mapMaybe $ foldOutput (const Nothing) (const Nothing) Just (const Nothing)-keepOutput :: ListLikePlus a c => [Output a] -> [a]-keepOutput = mapMaybe $ foldOutput (const Nothing) Just Just (const Nothing)-keepExceptions :: ListLikePlus a c => [Output a] -> [IOError]-keepExceptions = mapMaybe $ foldOutput (const Nothing) (const Nothing) (const Nothing) Just-keepResult :: ListLikePlus a c => [Output a] -> [ExitCode]-keepResult = mapMaybe $ foldOutput Just (const Nothing) (const Nothing) (const Nothing)+keepStdout :: ListLikePlus a c => [Chunk a] -> [a]+keepStdout = mapMaybe $ foldChunk (const Nothing) Just (const Nothing) (const Nothing) (const Nothing)+keepStderr :: ListLikePlus a c => [Chunk a] -> [a]+keepStderr = mapMaybe $ foldChunk (const Nothing) (const Nothing) Just (const Nothing) (const Nothing)+keepOutput :: ListLikePlus a c => [Chunk a] -> [a]+keepOutput = mapMaybe $ foldChunk (const Nothing) Just Just (const Nothing) (const Nothing)+keepExceptions :: ListLikePlus a c => [Chunk a] -> [IOError]+keepExceptions = mapMaybe $ foldChunk (const Nothing) (const Nothing) (const Nothing) Just (const Nothing)+keepResult :: ListLikePlus a c => [Chunk a] -> [ExitCode]+keepResult = mapMaybe $ foldChunk (const Nothing) (const Nothing) (const Nothing) (const Nothing) Just -mapMaybeResult :: ListLikePlus a c => (ExitCode -> Maybe (Output a)) -> [Output a] -> [Output a]-mapMaybeResult f = mapMaybe (foldOutput f (Just . Stdout) (Just . Stderr) (Just . Exception))-mapMaybeStdout :: ListLikePlus a c => (a -> Maybe (Output a)) -> [Output a] -> [Output a]-mapMaybeStdout f = mapMaybe (foldOutput (Just . Result) f (Just . Stderr) (Just . Exception))-mapMaybeStderr :: ListLikePlus a c => (a -> Maybe (Output a)) -> [Output a] -> [Output a]-mapMaybeStderr f = mapMaybe (foldOutput (Just . Result) (Just . Stdout) f (Just . Exception))-mapMaybeException :: ListLikePlus a c => (IOError -> Maybe (Output a)) -> [Output a] -> [Output a]-mapMaybeException f = mapMaybe (foldOutput (Just . Result) (Just . Stdout) (Just . Stderr) f)+mapMaybeResult :: ListLikePlus a c => (ExitCode -> Maybe (Chunk a)) -> [Chunk a] -> [Chunk a]+mapMaybeResult f = mapMaybe (foldChunk (Just . ProcessHandle) (Just . Stdout) (Just . Stderr) (Just . Exception) f)+mapMaybeStdout :: ListLikePlus a c => (a -> Maybe (Chunk a)) -> [Chunk a] -> [Chunk a]+mapMaybeStdout f = mapMaybe (foldChunk (Just . ProcessHandle) f (Just . Stderr) (Just . Exception) (Just . Result))+mapMaybeStderr :: ListLikePlus a c => (a -> Maybe (Chunk a)) -> [Chunk a] -> [Chunk a]+mapMaybeStderr f = mapMaybe (foldChunk (Just . ProcessHandle) (Just . Stdout) f (Just . Exception) (Just . Result))+mapMaybeException :: ListLikePlus a c => (IOError -> Maybe (Chunk a)) -> [Chunk a] -> [Chunk a]+mapMaybeException f = mapMaybe (foldChunk (Just . ProcessHandle) (Just . Stdout) (Just . Stderr) f (Just . Result)) -collectOutputs :: forall a c. ListLikePlus a c => [Output a] -> ([ExitCode], a, a, [IOError])+collectOutputs :: forall a c. ListLikePlus a c => [Chunk a] -> ([ExitCode], a, a, [IOError]) collectOutputs xs =-    foldOutputsR codefn outfn errfn exnfn result0 xs+    foldChunks (\ r -> foldChunk (pidfn r) (outfn r) (errfn r) (exnfn r) (codefn r)) result0 xs     where       result0 :: ([ExitCode], a, a, [IOError])       result0 = ([], empty, empty, [])+      pidfn :: ([ExitCode], a, a, [IOError]) -> ProcessHandle -> ([ExitCode], a, a, [IOError])+      pidfn (codes, outs, errs, exns) _ = (codes, outs, errs, exns)       codefn :: ([ExitCode], a, a, [IOError]) -> ExitCode -> ([ExitCode], a, a, [IOError])       codefn (codes, outs, errs, exns) code = (code : codes, outs, errs, exns)       outfn :: ([ExitCode], a, a, [IOError]) -> a -> ([ExitCode], a, a, [IOError])@@ -145,86 +149,91 @@ eMessageLn :: MonadIO m => String -> a -> m a eMessageLn s x = ePutStrLn s >> return x -foldException :: ListLikePlus a c => (IOError -> IO (Output a)) -> [Output a] -> IO [Output a]-foldException exnfn = mapM (foldOutput (return . Result) (return . Stdout) (return . Stderr) exnfn)+foldException :: ListLikePlus a c => (IOError -> IO (Chunk a)) -> [Chunk a] -> IO [Chunk a]+foldException exnfn = mapM (foldChunk (return . ProcessHandle) (return . Stdout) (return . Stderr) exnfn (return . Result)) -foldChars :: ListLikePlus a c => (a -> IO (Output a)) -> (a -> IO (Output a)) -> [Output a] -> IO [Output a]-foldChars outfn errfn = mapM (foldOutput (return . Result) outfn errfn (return . Exception))+foldChars :: ListLikePlus a c => (a -> IO (Chunk a)) -> (a -> IO (Chunk a)) -> [Chunk a] -> IO [Chunk a]+foldChars outfn errfn = mapM (foldChunk (return . ProcessHandle) outfn errfn (return . Exception)(return . Result)) -foldStdout :: ListLikePlus a c => (a -> IO (Output a)) -> [Output a] -> IO [Output a]+foldStdout :: ListLikePlus a c => (a -> IO (Chunk a)) -> [Chunk a] -> IO [Chunk a] foldStdout outfn = foldChars outfn (return . Stderr) -foldStderr :: ListLikePlus a c => (a -> IO (Output a)) -> [Output a] -> IO [Output a]+foldStderr :: ListLikePlus a c => (a -> IO (Chunk a)) -> [Chunk a] -> IO [Chunk a] foldStderr errfn = foldChars (return . Stdout) errfn -foldResult :: ListLikePlus a c => (ExitCode -> IO (Output a)) -> [Output a] -> IO [Output a]-foldResult codefn = mapM (foldOutput codefn (return . Stdout) (return . Stderr) (return . Exception))+foldResult :: ListLikePlus a c => (ExitCode -> IO (Chunk a)) -> [Chunk a] -> IO [Chunk a]+foldResult codefn = mapM (foldChunk (return . ProcessHandle) (return . Stdout) (return . Stderr) (return . Exception) codefn) -foldFailure :: ListLikePlus a c => (Int -> IO (Output a)) -> [Output a] -> IO [Output a]+foldFailure :: ListLikePlus a c => (Int -> IO (Chunk a)) -> [Chunk a] -> IO [Chunk a] foldFailure failfn = foldResult codefn     where codefn (ExitFailure n) = failfn n           codefn x = return (Result x) -foldResult' :: ListLikePlus a c => ([Output a] -> ExitCode -> IO (Output a)) -> [Output a] -> IO [Output a]-foldResult' codefn outputs = mapM (foldOutput (codefn outputs) (return . Stdout) (return . Stderr) (return . Exception)) outputs+foldResult' :: ListLikePlus a c => ([Chunk a] -> ExitCode -> IO (Chunk a)) -> [Chunk a] -> IO [Chunk a]+foldResult' codefn outputs = mapM (foldChunk (return . ProcessHandle) (return . Stdout) (return . Stderr) (return . Exception) (codefn outputs)) outputs -foldFailure' :: ListLikePlus a c => (Int -> IO (Output a)) -> [Output a] -> IO [Output a]+foldFailure' :: ListLikePlus a c => (Int -> IO (Chunk a)) -> [Chunk a] -> IO [Chunk a] foldFailure' failfn outputs = foldResult' codefn outputs-    where codefn outputs (ExitFailure n) = failfn n+    where codefn _outputs (ExitFailure n) = failfn n           codefn _ x = return (Result x) -foldSuccess :: ListLikePlus a c => IO (Output a) -> [Output a] -> IO [Output a]+foldSuccess :: ListLikePlus a c => IO (Chunk a) -> [Chunk a] -> IO [Chunk a] foldSuccess successfn = foldResult codefn     where codefn ExitSuccess = successfn           codefn x = return (Result x) -doException :: ListLikePlus a c => [Output a] -> IO [Output a]+doException :: ListLikePlus a c => [Chunk a] -> IO [Chunk a] doException = foldException throw -doOutput :: ListLikePlus a c => [Output a] -> IO [Output a]+doOutput :: ListLikePlus a c => [Chunk a] -> IO [Chunk a] doOutput = foldChars (\ cs -> hPutStr stdout cs >> return (Stdout cs)) (\ cs -> hPutStr stderr cs >> return (Stderr cs)) -doStdout :: ListLikePlus a c => [Output a] -> IO [Output a]+doStdout :: ListLikePlus a c => [Chunk a] -> IO [Chunk a] doStdout = foldStdout (\ cs -> hPutStr stdout cs >> return (Stdout cs)) -doStderr :: ListLikePlus a c => [Output a] -> IO [Output a]+doStderr :: ListLikePlus a c => [Chunk a] -> IO [Chunk a] doStderr = foldStderr (\ cs -> hPutStr stderr cs >> return (Stderr cs))  -- | I don't see much use for this.-doExit :: ListLikePlus a c => [Output a] -> IO [Output a]+doExit :: ListLikePlus a c => [Chunk a] -> IO [Chunk a] doExit = foldResult (\ code -> exitWith code >> return (Result code)) -doAll :: ListLikePlus a c => [Output a] -> IO [Output a]-doAll = mapM (foldOutput (\ code -> exitWith code >> return (Result code))+doAll :: ListLikePlus a c => [Chunk a] -> IO [Chunk a]+doAll = mapM (foldChunk (\ pid -> return (ProcessHandle pid))                          (\ cs -> hPutStr stdout cs >> return (Stdout cs))                          (\ cs -> hPutStr stderr cs >> return (Stderr cs))-                         throw)+                         throw+                         (\ code -> return (Result code))) -dots :: forall a c. NonBlocking a c => LengthType a -> (LengthType a -> IO ()) -> [Output a] -> IO [Output a]+dots :: (ListLikePlus a c, c ~ Char) => Int -> {- (Int -> IO ()) -> -} [Chunk a] -> IO [Chunk a]+dots charsPerDot chunks = putDots charsPerDot '.' chunks+{-+dots :: forall a c. ListLikePlus a c => Int -> (Int -> IO ()) -> [Chunk a] -> IO [Chunk a] dots charsPerDot nDots outputs =     nDots 1 >> dots' 0 outputs >>= eMessage "\n"     where       dots' _ [] = nDots 1 >> return []       dots' rem (x : xs) =-          do let (count', rem') = divMod (rem + foldOutput (const 0) length' length' (const 0) x) charsPerDot+          do let (count', rem') = divMod (rem + foldChunk (const 0) length length (const 0) (const 0) x) charsPerDot              when (count' > 0) (nDots count')              xs' <- dots' rem' xs              return (x : xs')+-}  -- | Output the stream with a prefix added at the beginning of each -- line of stdout and stderr.-prefixed :: forall a c. (Enum c, ListLikePlus a c) => a -> a -> [Output a] -> IO [Output a]+prefixed :: forall a c. (Enum c, ListLikePlus a c) => a -> a -> [Chunk a] -> IO [Chunk a] prefixed opre epre output =     mapM (\ (old, new) -> doOutput [new] >> return old) (prefixes opre epre output)  -- | Return the original stream of outputs zipped with one that has -- had prefixes for stdout and stderr inserted.  For the prefixed -- stream only, apply @map snd@.-prefixes :: forall a c. (Enum c, ListLikePlus a c) => a -> a -> [Output a] -> [(Output a, Output a)]+prefixes :: forall a c. (Enum c, ListLikePlus a c) => a -> a -> [Chunk a] -> [(Chunk a, Chunk a)] prefixes opre epre output =     loop True output     where-      loop :: (Enum c, ListLike a c) => Bool -> [Output a] -> [(Output a, Output a)]+      loop :: (Enum c, ListLike a c) => Bool -> [Chunk a] -> [(Chunk a, Chunk a)]       loop _ [] = []       loop bol (x@(Stdout s) : xs) = let (s', bol') = step bol opre s in (x, Stdout s') : loop bol' xs       loop bol (x@(Stderr s) : xs) = let (s', bol') = step bol epre s in (x, Stderr s') : loop bol' xs
System/Process/Read/Monad.hs view
@@ -21,13 +21,15 @@ import Control.Monad (when, unless) import Control.Monad.State (StateT(runStateT), get, put) import Control.Monad.Trans (MonadIO, liftIO)+import Data.Char (ord) import qualified Data.ListLike as P+import Data.Word (Word8) import Prelude hiding (print) import System.Exit (ExitCode(ExitFailure))-import System.IO (hPutStrLn, hPutStr, stderr)+import System.IO (hPutStrLn, stderr) import System.Process (CreateProcess(cmdspec), CmdSpec(RawCommand, ShellCommand), showCommandForUser)-import qualified System.Process.Read.Chars as P-import qualified System.Process.Read.Chunks as P+import qualified System.Process.Chunks as P+import qualified System.Process.ListLike as P import qualified System.Process.Read.Convenience as P  -- | The state we need when running processes@@ -76,21 +78,24 @@ setPrefixes :: (P.ListLikePlus s c, MonadIO m) => Maybe (s, s) -> RunT s m () setPrefixes x = modifyRunState (\ s -> s {prefixes = x}) -runProcessM :: forall s c m. (P.NonBlocking s c, Enum c, MonadIO m) => CreateProcess -> s -> RunT s m [P.Output s]+runProcessM :: forall s c m. (P.ListLikePlus s c, Enum c, MonadIO m, c ~ Word8) => CreateProcess -> s -> RunT s m [P.Chunk s] runProcessM p input =     do s <- get        liftIO $ do          when (trace s) (hPutStrLn stderr ("-> " ++ showCommand (cmdspec p)))-         (out1 :: [P.Output s]) <- P.readProcessChunks p input-         (out2 :: [P.Output s]) <- if cpd s > 0 then P.dots (fromIntegral (cpd s)) (\ n -> hPutStr stderr (replicate (fromIntegral n) '.')) out1 else return out1-         (out3 :: [P.Output s]) <- if echo s then doOutput (prefixes s) out2 else return out2-         (out5 :: [P.Output s]) <- if failExit s then P.foldFailure' (\ n -> doOutput (exnPrefixes s) out3 >> error (showCommand (cmdspec p) ++ " -> ExitFailure " ++ show n)) out3 else return out3-         (out6 :: [P.Output s]) <- (if trace s then  P.foldResult (\ ec -> hPutStrLn stderr ("<- " ++ showCommand (cmdspec p) ++ ": " ++ show ec) >> return (P.Result ec)) else return) out5-         (out7 :: [P.Output s]) <- (if failEcho s then P.foldFailure (\ n -> unless (trace s) (hPutStrLn stderr ("<- " ++ showCommand (cmdspec p) ++ ": " ++ show (ExitFailure n))) >>+         (out1 :: [P.Chunk s]) <- P.readProcessChunks p input+         (out2 :: [P.Chunk s]) <- if cpd s > 0 then P.putDots (cpd s) dot out1 else return out1+         (out3 :: [P.Chunk s]) <- if echo s then doOutput (prefixes s) out2 else return out2+         (out5 :: [P.Chunk s]) <- if failExit s then P.foldFailure' (\ n -> doOutput (exnPrefixes s) out3 >> error (showCommand (cmdspec p) ++ " -> ExitFailure " ++ show n)) out3 else return out3+         (out6 :: [P.Chunk s]) <- (if trace s then  P.foldResult (\ ec -> hPutStrLn stderr ("<- " ++ showCommand (cmdspec p) ++ ": " ++ show ec) >> return (P.Result ec)) else return) out5+         (out7 :: [P.Chunk s]) <- (if failEcho s then P.foldFailure (\ n -> unless (trace s) (hPutStrLn stderr ("<- " ++ showCommand (cmdspec p) ++ ": " ++ show (ExitFailure n))) >>                                                                               doOutput (prefixes s) out5 >> return (P.Result (ExitFailure n))) else return) out6          return out7+    where+      dot :: Word8+      dot = fromIntegral (ord '.') -doOutput :: (P.ListLikePlus a c, Enum c) => Maybe (a, a) -> [P.Output a] -> IO [P.Output a]+doOutput :: (P.ListLikePlus a c, Enum c) => Maybe (a, a) -> [P.Chunk a] -> IO [P.Chunk a] doOutput prefixes out = maybe (P.doOutput out) (\ (sout, serr) -> P.prefixed sout serr out) prefixes >> return out -- doOutput prefixes out = P.doOutput out >> return out @@ -113,56 +118,56 @@ e = echoOnFailure True >> setPrefixes (Just (P.fromList (map (toEnum . fromEnum) " 1> "), P.fromList (map (toEnum . fromEnum) " 2> "))) >> exceptionOnFailure True >> echoOutput False  -- | Run silently-runProcessS :: (P.NonBlocking a c, Enum c, MonadIO m) => CreateProcess -> a -> m [P.Output a]+runProcessS :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => CreateProcess -> a -> m [P.Chunk a] runProcessS p input = withRunState defaultRunState (s >> runProcessM p input)  -- | Command line trace only.-runProcessQ :: (P.NonBlocking a c, Enum c, MonadIO m) => CreateProcess -> a -> m [P.Output a]+runProcessQ :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => CreateProcess -> a -> m [P.Chunk a] runProcessQ p input = withRunState defaultRunState (runProcessM p input)  -- | Dot output-runProcessD :: (P.NonBlocking a c, Enum c, MonadIO m) => CreateProcess -> a -> m [P.Output a]+runProcessD :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => CreateProcess -> a -> m [P.Chunk a] runProcessD p input =     withRunState defaultRunState (c >> d >> runProcessM p input)  -- | Echo output-runProcessV :: (P.NonBlocking a c, Enum c, MonadIO m) => CreateProcess -> a -> m [P.Output a]+runProcessV :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => CreateProcess -> a -> m [P.Chunk a] runProcessV p input =     withRunState defaultRunState (c >> v >> runProcessM p input)  -- | Exception on failure-runProcessSF :: (P.NonBlocking a c, Enum c, MonadIO m) => CreateProcess -> a -> m [P.Output a]+runProcessSF :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => CreateProcess -> a -> m [P.Chunk a] runProcessSF p input =     withRunState defaultRunState (s >> f >> runProcessM p input) -runProcessQF :: (P.NonBlocking a c, Enum c, MonadIO m) => CreateProcess -> a -> m [P.Output a]+runProcessQF :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => CreateProcess -> a -> m [P.Chunk a] runProcessQF p input =     withRunState defaultRunState (c >> f >> runProcessM p input)  -- | Dot output and exception on failure-runProcessDF :: (P.NonBlocking a c, Enum c, MonadIO m) => CreateProcess -> a -> m [P.Output a]+runProcessDF :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => CreateProcess -> a -> m [P.Chunk a] runProcessDF p input =     withRunState defaultRunState (c >> d >> f >> runProcessM p input)  -- | Echo output and exception on failure-runProcessVF :: (P.NonBlocking a c, Enum c, MonadIO m) => CreateProcess -> a -> m [P.Output a]+runProcessVF :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => CreateProcess -> a -> m [P.Chunk a] runProcessVF p input =     withRunState defaultRunState (c >> v >> f >> runProcessM p input)  -- | Exception and echo on failure-runProcessSE :: (P.NonBlocking a c, Enum c, MonadIO m) => Maybe (a, a) -> CreateProcess -> a -> m [P.Output a]+runProcessSE :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => Maybe (a, a) -> CreateProcess -> a -> m [P.Chunk a] runProcessSE prefixes p input =     withRunState (defaultRunState {exnPrefixes = prefixes}) (s >> e >> runProcessM p input)  -- | Exception and echo on failure-runProcessQE :: (P.NonBlocking a c, Enum c, MonadIO m) => Maybe (a, a) -> CreateProcess -> a -> m [P.Output a]+runProcessQE :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => Maybe (a, a) -> CreateProcess -> a -> m [P.Chunk a] runProcessQE prefixes p input =     withRunState (defaultRunState {exnPrefixes = prefixes}) (c >> e >> runProcessM p input)  -- | Dot output, exception on failure, echo on failure.  Note that -- runProcessVE isn't a useful option, you get the output twice.  VF -- makes more sense.-runProcessDE :: (P.NonBlocking a c, Enum c, MonadIO m) => Maybe (a, a) -> CreateProcess -> a -> m [P.Output a]+runProcessDE :: (P.ListLikePlus a c, Enum c, MonadIO m, c ~ Word8) => Maybe (a, a) -> CreateProcess -> a -> m [P.Chunk a] runProcessDE prefixes p input =     withRunState (defaultRunState {exnPrefixes = prefixes}) (c >> d >> e >> runProcessM p input)
− System/Process/Read/Verbosity.hs 
@@ -1,99 +0,0 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}-module System.Process.Read.Verbosity-    ( quieter-    , noisier-    , withModifiedVerbosity-    , defaultVerbosity-    , verbosity-    -- * Process functions controlled by the VERBOSITY level.-    , runProcess-    , runProcessF-    -- * Output functions controlled by the VERBOSITY level.  We want these-    -- to output whenever the runProcess functions are not silent, and we want-    -- them to output at the first silent output setting, but then to stop.-    , qPutStr-    , qPutStrLn-    , qMessage-    , qMessageLn-    , qBracket-    ) where--import Control.Monad (when)-import Control.Monad.Trans (MonadIO, liftIO)-import System.Process (CreateProcess)-import System.Posix.EnvPlus (getEnv, modifyEnv)-import System.Process.Read.Chunks (Output, NonBlocking)-import System.Process.Read.Convenience (ePutStr, ePutStrLn)-import System.Process.Read.Monad (runProcessS, runProcessQ, runProcessD, runProcessV,-                                  runProcessSF, {-runProcessQF, runProcessDF,-} runProcessVF,-                                  runProcessSE, runProcessQE, runProcessDE)--quieter :: MonadIO m => Int -> m a -> m a-quieter n action = withModifiedVerbosity (\ v -> v - n) action-noisier :: MonadIO m => Int -> m a -> m a-noisier n action = withModifiedVerbosity (\ v -> v + n) action--withModifiedVerbosity :: MonadIO m => (Int -> Int) -> m a -> m a-withModifiedVerbosity f action =-    verbosity >>= \ v ->-    liftIO (modifyEnv "VERBOSITY" (const (Just (show (f v))))) >>-    -- ePutStr ("[" ++ show (f v) ++ "]") >>-    action >>= \ result ->-    -- ePutStr ("[" ++ show v ++ "]") >>-    liftIO (modifyEnv "VERBOSITY" (const (Just (show v)))) >>-    return result--defaultVerbosity :: Int-defaultVerbosity = 1--verbosity :: MonadIO m => m Int-verbosity = liftIO $ getEnv "VERBOSITY" >>= return . maybe 1 read---- | Select from the runProcess* functions in Monad based on a verbosity level.-runProcess :: (NonBlocking s c, Enum c, MonadIO m) => CreateProcess -> s -> m [Output s]-runProcess p input = liftIO $-    verbosity >>= \ v ->-    case v of-      _ | v <= 0 -> runProcessS p input-      1 -> runProcessQ p input-      2 -> runProcessD p input-      _ -> runProcessV p input---- | A version of 'runProcess' that throws an exception on failure.-runProcessF :: (NonBlocking s c, Enum c, MonadIO m) => Maybe (s, s) -> CreateProcess -> s -> m [Output s]-runProcessF prefixes p input = liftIO $-    verbosity >>= \ v ->-    case v of-      _ | v < 0 -> runProcessSF p input-      0 -> runProcessSE prefixes p input-      1 -> runProcessQE prefixes p input-      2 -> runProcessDE prefixes p input-      _ -> runProcessVF p input--qPutStrLn :: MonadIO m => String -> m ()-qPutStrLn s = verbosity >>= \ v -> when (v > 0) (ePutStrLn s)--qPutStr :: MonadIO m => String -> m ()-qPutStr s = verbosity >>= \ v -> when (v > 0) (ePutStr s)--qMessage :: MonadIO m => String -> a -> m a-qMessage s x = qPutStr s >> return x--qMessageLn :: MonadIO m => String -> a -> m a-qMessageLn s x = qPutStrLn s >> return x--qBracket :: MonadIO m => String -> m a -> m a-qBracket message action = do-  v <- verbosity-  case v of-    n | n < 1 -> action-    1 -> do-      qPutStr (message ++ "...")-      result <- quieter 1 action-      qPutStrLn "done."-      return result-    n -> do-      qPutStrLn message-      result <- quieter 1 action-      qPutStrLn (message ++ "...done.")-      return result
− Tests/Main.hs 
@@ -1,67 +0,0 @@-module Main where--import qualified Codec.Binary.UTF8.String as UTF8-import qualified Data.ByteString.Lazy as L-import Data.ListLike (ListLike(concat))-import Prelude hiding (length, concat)-import System.Exit-import System.Posix.Files (getFileStatus, fileMode, setFileMode, unionFileModes, ownerExecuteMode, groupExecuteMode, otherExecuteMode)-import System.Process (proc, shell)-import System.Process.Progress (Output(..), readProcessChunks, keepStdout, discardStdout, collectOutputs)-import System.Process.Read.Chunks (readProcessChunks')-import Test.HUnit hiding (path)--main :: IO ()-main =-    do chmod "Tests/Test1.hs"-       chmod "Tests/Test2.hs"-       chmod "Tests/Test4.hs"-       (c,st) <- runTestText putTextToShowS test1 -- (TestList (versionTests ++ sourcesListTests ++ dependencyTests ++ changesTests))-       putStrLn (st "")-       case (failures c) + (errors c) of-         0 -> return ()-         _ -> exitFailure--encode :: String -> L.ByteString-encode = L.pack . UTF8.encode--chmod :: FilePath -> IO ()-chmod path =-    getFileStatus "Tests/Test1.hs" >>= \ status ->-    setFileMode path (foldr unionFileModes (fileMode status) [ownerExecuteMode, groupExecuteMode, otherExecuteMode])--test1 :: Test-test1 =-    TestLabel "test1"-      (TestList-       [ TestLabel "pnmfile3" $-         TestCase (do jpg <- L.readFile "Tests/penguin.jpg"-                      pnm <- readProcessChunks (proc "djpeg" []) jpg >>= return . concat . keepStdout :: IO L.ByteString-                      info <- readProcessChunks (proc "pnmfile" []) pnm >>= return . concat . keepStdout :: IO L.ByteString-                      assertEqual "pnmfile3" (encode "stdin:\tPPM raw, 96 by 96  maxval 255\n") info)-       , test2-       , TestLabel "readProcessChunks stdout stderr" $-         TestCase (do out <- readProcessChunks (shell "yes | head -10 | while read i; do echo stdout; echo stderr 1>&2; done") L.empty-                      let result = collectOutputs out-                      assertEqual "readProcessChunks stdout stderr" ([ExitSuccess], encode "stdout\nstdout\nstdout\nstdout\nstdout\nstdout\nstdout\nstdout\nstdout\nstdout\n", encode "stderr\nstderr\nstderr\nstderr\nstderr\nstderr\nstderr\nstderr\nstderr\nstderr\n", []) result)-       , test3-       , TestLabel "readProcessChunks' stdout stderr" $-         TestCase (do out <- readProcessChunks' (shell "yes | head -10 | while read i; do echo stdout; echo stderr 1>&2; done") L.empty-                      let result = collectOutputs out-                      assertEqual "readProcessChunks' stdout stderr" ([ExitSuccess], encode "stdout\nstdout\nstdout\nstdout\nstdout\nstdout\nstdout\nstdout\nstdout\nstdout\n", encode "stderr\nstderr\nstderr\nstderr\nstderr\nstderr\nstderr\nstderr\nstderr\nstderr\n", []) result)-{--       , TestLabel "timed dot test" $-         TestCase (do output <- readModifiedProcess id (ShellCommand "Tests/Test2.hs") "" >>= return . take 10-                      assertEqual "timed dot test" ".........." output)--}-       ])--test2 :: Test-test2 = TestLabel "readProcessChunks gzip" $-        TestCase (do result <- readProcessChunks (shell "gzip -v -f < Tests/penguin.jpg") L.empty-                     assertEqual "readProcessChunks gzip" [Stderr (encode "  2.0%\n"),Result ExitSuccess] (discardStdout result))--test3 :: Test-test3 = TestLabel "readProcessChunks' gzip'" $-        TestCase (do result <- readProcessChunks' (shell "gzip -v -f < Tests/penguin.jpg") L.empty-                     assertEqual "readProcessChunks' gzip" [Stderr (encode "  2.0%\n"),Result ExitSuccess] (discardStdout result))
changelog view
@@ -1,3 +1,37 @@+haskell-process-progress (0.14) unstable; urgency=low++  * Remove Tests, they were all duplicates of the ones in+    process-listlike.++ -- David Fox <dsf@seereason.com>  Tue, 02 Sep 2014 08:50:04 -0700++haskell-process-progress (0.13) unstable; urgency=low++  * Finish conversion to new readInterleaved code.++ -- David Fox <dsf@seereason.com>  Wed, 27 Aug 2014 12:14:17 -0700++haskell-process-progress (0.12) unstable; urgency=low++  * Move System.Process.Read.Verbosity into a separate package.++ -- David Fox <dsf@seereason.com>  Sun, 24 Aug 2014 14:10:20 -0700++haskell-process-progress (0.11) unstable; urgency=low++  * Support interleaving of output from a list of file handles+  * Use the simpler MVar based version of the interleaved reader++ -- David Fox <dsf@seereason.com>  Mon, 28 Jul 2014 23:07:53 -0700++haskell-process-progress (0.10) unstable; urgency=low++  * When DEBUG_VERBOSITY environment variable is set, prefix each string+    output by vPutStr of vPutStrLn with the current verbosity level, and+    don't suppress any output.++ -- David Fox <dsf@seereason.com>  Fri, 30 May 2014 13:36:08 -0700+ haskell-process-progress (0.9) unstable; urgency=low    * Now $VERBOSITY<=0 means the qPutStr and qPutStrLn functions don't
process-progress.cabal view
@@ -1,5 +1,5 @@ Name:               process-progress-Version:            0.9+Version:            0.14 Synopsis:           Run a process and do reportsing on its progress. Description:        Function to run a process and wrappers to provide different                     types of feedback while it executes.@@ -14,7 +14,7 @@  source-repository head   Type:             darcs-  Location:         http://src.seereason.com/debian-tools/process-progress+  Location:         http://src.seereason.com/process-progress  Library   ghc-options:      -Wall -O2 -threaded@@ -22,16 +22,14 @@   Exposed-modules:     System.Posix.EnvPlus     System.Process.Progress-    System.Process.Read.Chunks     System.Process.Read.Compat     System.Process.Read.Convenience     System.Process.Read.Monad-    System.Process.Read.Verbosity    Build-depends:     base >= 4 && < 5,     process,-    process-listlike >= 0.6,+    process-listlike >= 0.9,     bytestring,     deepseq,     HUnit,@@ -42,7 +40,3 @@     time,     unix,     utf8-string--Executable tests-  Main-Is: Tests/Main.hs-  GHC-Options: -Wall -O2 -threaded -rtsopts