process-progress (empty) → 0.9

raw patch · 11 files changed

+1073/−0 lines, 11 filesdep +HUnitdep +ListLikedep +basesetup-changed

Dependencies added: HUnit, ListLike, base, bytestring, deepseq, mtl, process, process-listlike, text, time, unix, utf8-string

Files

Setup.hs +20/−0
System/Posix/EnvPlus.hs +11/−0
System/Process/Progress.hs +17/−0
System/Process/Read/Chunks.hs +294/−0
System/Process/Read/Compat.hs +37/−0
System/Process/Read/Convenience.hs +245/−0
System/Process/Read/Monad.hs +171/−0
System/Process/Read/Verbosity.hs +99/−0
Tests/Main.hs +67/−0
changelog +64/−0
process-progress.cabal +48/−0

+ Setup.hs view

@@ -0,0 +1,20 @@+import Distribution.Simple+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(buildDir))+import Distribution.Simple.Program+import System.Cmd+import System.Directory+import System.Exit++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"

+ System/Posix/EnvPlus.hs view

@@ -0,0 +1,11 @@+module System.Posix.EnvPlus+    ( module System.Posix.Env+    , modifyEnv+    ) where++import System.Posix.Env++-- | Generalization of Posix setEnv/unSetEnv.+modifyEnv :: String -> (Maybe String -> Maybe String) -> IO ()+modifyEnv name f =+    getEnv name >>= maybe (unsetEnv name) (\ x -> setEnv name x True) . f

+ System/Process/Progress.hs view

@@ -0,0 +1,17 @@+-- | `Functions to run a process and manage the type and amount of output+-- it generates.+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module System.Process.Progress+    ( module System.Process.Read.Chunks+    , 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 view

@@ -0,0 +1,294 @@+-- | 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

@@ -0,0 +1,37 @@+-- | Some functions brought over from my obsolete progress packages.+{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies #-}+module System.Process.Read.Compat+    ( echo+    , oneResult+    , timeTask+    ) where++import Control.Exception (evaluate)+import Data.Time (NominalDiffTime, getCurrentTime, diffUTCTime)+import System.Exit (ExitCode(..))+import System.Process (CmdSpec(..), showCommandForUser)+import System.Process.Read.Chars (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 ()+echo (RawCommand cmd args) io = ePutStrLn ("-> " ++ showCommandForUser cmd args) >> io+echo (ShellCommand cmd) io = ePutStrLn ("-> " ++ cmd) >> io++-- | 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 xs =+    case keepResult xs of+      [code] -> code+      [] -> error "Missing result code"+      codes -> error $ "Multiple result codes: " ++ show codes++-- | Run a task and return the elapsed time along with its result.+timeTask :: IO a -> IO (a, NominalDiffTime)+timeTask x =+    do start <- getCurrentTime+       result <- x >>= evaluate+       finish <- getCurrentTime+       return (result, diffUTCTime finish start)

+ System/Process/Read/Convenience.hs view

@@ -0,0 +1,245 @@+{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+module System.Process.Read.Convenience+    ( -- * Predicates+      isResult+    , isStdout+    , isStderr+    , isOutput+    , isException+    -- * Filters+    , discardStdout+    , discardStderr+    , discardOutput+    , discardExceptions+    , discardResult+    , keepStdout+    , keepStderr+    , keepOutput+    , keepExceptions+    , keepResult+    -- * Transformers+    , mergeToStdout+    , mergeToStderr+    , mapMaybeResult+    , mapMaybeStdout+    , mapMaybeStderr+    , mapMaybeException+    -- * Collectors+    , collectOutputs+    -- * IO operations+    , ePutStr+    , ePutStrLn+    , eMessage+    , eMessageLn++    , foldException+    , foldChars+    , foldStdout+    , foldStderr+    , foldResult+    , foldSuccess+    , foldFailure+    , foldFailure'++    , doException+    , doOutput+    , doStdout+    , doStderr+    , doExit+    , doAll++    , dots+    , prefixed+    ) 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)+import Prelude hiding (length, rem, concat, span, tail, null)+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 ()++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)++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++mergeToStdout :: ListLikePlus a c => [Output a] -> [Output a]+mergeToStdout = map toStdout+mergeToStderr :: ListLikePlus a c => [Output a] -> [Output a]+mergeToStderr = map toStderr++discardStdout :: ListLikePlus a c => [Output a] -> [Output a]+discardStdout = filter (not . isStdout)+discardStderr :: ListLikePlus a c => [Output a] -> [Output a]+discardStderr = filter (not . isStderr)+discardOutput :: ListLikePlus a c => [Output a] -> [Output a]+discardOutput = filter (\ x -> not (isStdout x || isStderr x))+discardExceptions :: ListLikePlus a c => [Output a] -> [Output a]+discardExceptions = filter (not . isException)+discardResult :: ListLikePlus a c => [Output a] -> [Output 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)++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)++collectOutputs :: forall a c. ListLikePlus a c => [Output a] -> ([ExitCode], a, a, [IOError])+collectOutputs xs =+    foldOutputsR codefn outfn errfn exnfn result0 xs+    where+      result0 :: ([ExitCode], a, a, [IOError])+      result0 = ([], empty, empty, [])+      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])+      outfn (codes, outs, errs, exns) out = (codes, append out outs, errs, exns)+      errfn :: ([ExitCode], a, a, [IOError]) -> a -> ([ExitCode], a, a, [IOError])+      errfn (codes, outs, errs, exns) err = (codes, outs, append err errs, exns)+      exnfn :: ([ExitCode], a, a, [IOError]) -> IOError -> ([ExitCode], a, a, [IOError])+      exnfn (codes, outs, errs, exns) exn = (codes, outs, errs, exn : exns)++ePutStr :: MonadIO m => String -> m ()+ePutStr s = liftIO $ IO.hPutStr stderr s++ePutStrLn :: MonadIO m => String -> m ()+ePutStrLn s = liftIO $ IO.hPutStrLn stderr s++eMessage :: MonadIO m => String -> a -> m a+eMessage s x = ePutStr s >> return x++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)++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))++foldStdout :: ListLikePlus a c => (a -> IO (Output a)) -> [Output a] -> IO [Output a]+foldStdout outfn = foldChars outfn (return . Stderr)++foldStderr :: ListLikePlus a c => (a -> IO (Output a)) -> [Output a] -> IO [Output 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))++foldFailure :: ListLikePlus a c => (Int -> IO (Output a)) -> [Output a] -> IO [Output 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++foldFailure' :: ListLikePlus a c => (Int -> IO (Output a)) -> [Output a] -> IO [Output a]+foldFailure' failfn outputs = foldResult' codefn outputs+    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 successfn = foldResult codefn+    where codefn ExitSuccess = successfn+          codefn x = return (Result x)++doException :: ListLikePlus a c => [Output a] -> IO [Output a]+doException = foldException throw++doOutput :: ListLikePlus a c => [Output a] -> IO [Output 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 = foldStdout (\ cs -> hPutStr stdout cs >> return (Stdout cs))++doStderr :: ListLikePlus a c => [Output a] -> IO [Output 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 = 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))+                         (\ cs -> hPutStr stdout cs >> return (Stdout cs))+                         (\ cs -> hPutStr stderr cs >> return (Stderr cs))+                         throw)++dots :: forall a c. NonBlocking a c => LengthType a -> (LengthType a -> IO ()) -> [Output a] -> IO [Output 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+             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 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 opre epre output =+    loop True output+    where+      loop :: (Enum c, ListLike a c) => Bool -> [Output a] -> [(Output a, Output 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+      loop bol (x : xs) = (x, Stdout empty) : loop bol xs++      step :: (Enum c, ListLike a c) => Bool -> a -> a -> (a, Bool)+      step bol pre s =+          let (a, b) = Data.ListLike.span (\ c -> fromEnum c /= fromEnum '\n') s in+          if null a+          then if null b+               then (empty, bol)+               else let x = (if bol then pre else empty)+                        (s', bol') = step True pre (tail b) in+                    (concat [x, singleton (toEnum . fromEnum $ '\n'), s'], bol')+          -- There is some text before a possible newline+          else let x = (if bol then append pre a else a)+                   (s', bol') = step False pre b in+               (append x s', bol')

+ System/Process/Read/Monad.hs view

@@ -0,0 +1,171 @@+-- | A perhaps over-engineered set of wrappers around+-- readProcessChunks to run processes with a variety of echoing+-- options and responses to failure.+{-# LANGUAGE FlexibleContexts, FlexibleInstances, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+module System.Process.Read.Monad+    ( -- * Run processes with various types and amounts of feedback+      runProcessS+    , runProcessQ+    , runProcessD+    , runProcessV+    , runProcessSF+    , runProcessQF+    , runProcessDF+    , runProcessVF+    , runProcessSE+    , runProcessQE+    , runProcessDE+    ) where++import Control.Monad (when, unless)+import Control.Monad.State (StateT(runStateT), get, put)+import Control.Monad.Trans (MonadIO, liftIO)+import qualified Data.ListLike as P+import Prelude hiding (print)+import System.Exit (ExitCode(ExitFailure))+import System.IO (hPutStrLn, hPutStr, 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.Read.Convenience as P++-- | The state we need when running processes+data RunState s+    = RunState+      { cpd :: Int  -- ^ Output one dot per n characters of process output, 0 means no dots+      , trace :: Bool -- ^ Echo the command line before starting, and after with the result code+      , echo :: Bool -- ^ Echo the output as it is red, using the prefixes set below+      , prefixes :: Maybe (s, s)+      -- ^ Prepend a prefix to the echoed lines of stdout and stderr.+      --  Special case for Just ("", ""), which means echo unmodified output.+      , exnPrefixes :: Maybe (s, s)+      -- ^ Prefixes to use when generating output after an exception occurs.+      , failEcho :: Bool -- ^ Echo the process output if the result code is ExitFailure+      , failExit :: Bool -- ^ Throw an IOError if the result code is ExitFailure+      } deriving (Show)++defaultRunState :: RunState s+defaultRunState = RunState {cpd=0, trace=True, echo=False, failEcho=False, failExit=False, prefixes=Nothing, exnPrefixes=Nothing}++-- | The monad for running processes+type RunT s = StateT (RunState s)++withRunState :: MonadIO m => RunState s -> RunT s m a -> m a+withRunState s action =+    (runStateT action) s >>= return . fst++modifyRunState :: MonadIO m => (RunState s -> RunState s) -> RunT s m ()+modifyRunState modify = get >>= put . modify++charsPerDot :: MonadIO m => Int -> RunT s m ()+charsPerDot x = modifyRunState (\ s -> s {cpd = x})++echoCommand :: MonadIO m => Bool -> RunT s m ()+echoCommand x = modifyRunState (\ s -> s {trace = x})++echoOnFailure :: MonadIO m => Bool -> RunT s m ()+echoOnFailure x = modifyRunState (\ s -> s {failEcho = x})++exceptionOnFailure :: MonadIO m => Bool -> RunT s m ()+exceptionOnFailure x = modifyRunState (\ s -> s {failExit = x})++echoOutput :: MonadIO m => Bool -> RunT s m ()+echoOutput x = modifyRunState (\ s -> s {echo = x})++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 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))) >>+                                                                              doOutput (prefixes s) out5 >> return (P.Result (ExitFailure n))) else return) out6+         return out7++doOutput :: (P.ListLikePlus a c, Enum c) => Maybe (a, a) -> [P.Output a] -> IO [P.Output 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++s :: MonadIO m => RunT s m ()+s = echoCommand False++c :: MonadIO m => RunT s m ()+c = echoCommand True++v :: (Enum c, P.ListLikePlus s c, MonadIO m) => RunT s m ()+v = echoOutput True >> setPrefixes (Just (P.fromList (map (toEnum . fromEnum) " 1> "), P.fromList (map (toEnum . fromEnum) " 2> "))) >> echoOnFailure False++d :: MonadIO m => RunT s m ()+d = charsPerDot 50 >> echoOutput False++f :: MonadIO m => RunT s m ()+f = exceptionOnFailure True++e :: (Enum c, P.ListLikePlus s c, MonadIO m) => RunT s m ()+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 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 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 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 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 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 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 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 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 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 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 prefixes p input =+    withRunState (defaultRunState {exnPrefixes = prefixes}) (c >> d >> e >> runProcessM p input)++showCommand :: CmdSpec -> String+showCommand (RawCommand cmd args) = showCommandForUser cmd args+showCommand (ShellCommand cmd) = cmd

+ System/Process/Read/Verbosity.hs view

@@ -0,0 +1,99 @@+{-# 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 view

@@ -0,0 +1,67 @@+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

@@ -0,0 +1,64 @@+haskell-process-progress (0.9) unstable; urgency=low++  * Now $VERBOSITY<=0 means the qPutStr and qPutStrLn functions don't+    generate output, one or greater and they do.+  * Add qBracket++ -- David Fox <dsf@seereason.com>  Mon, 06 Jan 2014 13:25:29 -0800++haskell-process-progress (0.8) unstable; urgency=low++  * Move the NFData ExitCode instance here from debian-repo+  * Minor documentation updates++ -- David Fox <dsf@seereason.com>  Wed, 01 Jan 2014 09:40:50 -0800++haskell-process-progress (0.7) unstable; urgency=low++  * Fix the prefix feature, which prepends different prefixes to the+    lines of stdout and stderr.++ -- David Fox <dsf@seereason.com>  Mon, 23 Dec 2013 21:46:47 -0800++haskell-process-progress (0.6) unstable; urgency=low++  * Add option to echo output with prefixes on exception++ -- David Fox <dsf@seereason.com>  Mon, 09 Dec 2013 06:22:34 -0800++haskell-process-progress (0.5.3) unstable; urgency=low++  * Make changelog visible on hackage.++ -- David Fox <dsf@seereason.com>  Tue, 15 Oct 2013 07:39:38 -0700++haskell-process-progress (0.5.2) unstable; urgency=low++  * Fix the repository location in the cabal file.++ -- David Fox <dsf@seereason.com>  Sat, 31 Aug 2013 07:58:14 -0700++haskell-process-progress (0.5.1) unstable; urgency=low++  * Switch dependency from process-extras to process-listlike.++ -- David Fox <dsf@seereason.com>  Sat, 25 May 2013 08:22:42 -0700++haskell-process-progress (0.5) unstable; urgency=low++  * Changes for process-extras-0.6.++ -- David Fox <dsf@seereason.com>  Wed, 28 Nov 2012 09:59:27 -0800++haskell-process-progress (0.4.7) unstable; urgency=low++  * Bring over changes from retired darcs repository.++ -- David Fox <dsf@seereason.com>  Fri, 02 Nov 2012 16:47:06 -0700++haskell-process-progress (0.4.5) unstable; urgency=low++  * Debianization generated by cabal-debian++ -- SeeReason Autobuilder <partners@seereason.com>  Wed, 24 Oct 2012 15:18:01 -0700+

+ process-progress.cabal view

@@ -0,0 +1,48 @@+Name:               process-progress+Version:            0.9+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.+Homepage:           https://src.seereason.com/process-progress+License:            BSD3+Author:             David Fox+Maintainer:         David Fox <dsf@seereason.com>+Category:           System+Build-type:         Simple+Cabal-version:      >=1.6+Extra-source-files: changelog++source-repository head+  Type:             darcs+  Location:         http://src.seereason.com/debian-tools/process-progress++Library+  ghc-options:      -Wall -O2 -threaded++  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,+    bytestring,+    deepseq,+    HUnit,+    ListLike,+    mtl,+    process,+    text,+    time,+    unix,+    utf8-string++Executable tests+  Main-Is: Tests/Main.hs+  GHC-Options: -Wall -O2 -threaded -rtsopts