packages feed

process-listlike 0.9 → 0.10

raw patch · 30 files changed

+1191/−946 lines, 30 filesdep +regex-posixdep ~ListLikedep ~basedep ~bytestringsetup-changednew-component:exe:process-listlike-interactive-tests

Dependencies added: regex-posix

Dependency ranges changed: ListLike, base, bytestring, process

Files

+ README.md view
@@ -0,0 +1,9 @@+# About++Extra functionality for the [Process library](http://hackage.haskell.org/package/process).++# Contributing++This project is available on [GitHub](https://github.com/davidlazar/process-extras) and [Bitbucket](https://bitbucket.org/davidlazar/process-extras/). You may contribute changes using either.++Please report bugs and feature requests using the [GitHub issue tracker](https://github.com/davidlazar/process-extras/issues).
Setup.hs view
@@ -1,20 +1,2 @@ import Distribution.Simple-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(buildDir))-import Distribution.Simple.Program-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 ++ "/process-listlike-tests/process-listlike-tests") >>= \ code ->-    if code == ExitSuccess then return () else error "unit test failure"+main = defaultMain
− System/Process/ByteString.hs 
@@ -1,24 +0,0 @@--- | "System.Process.ListLike" functions restricted to type 'Data.ByteString.Char8.ByteString'.-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module System.Process.ByteString-    ( readProcess-    , readProcessWithExitCode-    , readCreateProcess-    , readCreateProcessWithExitCode-    ) where--import Data.ByteString.Char8 (ByteString)-import System.Exit (ExitCode)-import System.Process (CreateProcess)-import qualified System.Process.ListLike as R-import System.Process.Strict ()--readProcess :: (a ~ ByteString) => FilePath -> [String] -> a -> IO a-readProcess = R.readProcess-readProcessWithExitCode :: (a ~ ByteString) => FilePath -> [String] -> a -> IO (ExitCode, a, a)-readProcessWithExitCode = R.readProcessWithExitCode-readCreateProcess :: (a ~ ByteString) => CreateProcess -> a -> IO a-readCreateProcess = R.readCreateProcess-readCreateProcessWithExitCode :: (a ~ ByteString) => CreateProcess -> a -> IO (ExitCode, a, a)-readCreateProcessWithExitCode = R.readCreateProcessWithExitCode
− System/Process/ByteString/Lazy.hs 
@@ -1,24 +0,0 @@--- | "System.Process.ListLike" functions restricted to the lazy 'Data.ByteString.Lazy.Char8.ByteString' type.-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module System.Process.ByteString.Lazy-    ( readProcess-    , readProcessWithExitCode-    , readCreateProcess-    , readCreateProcessWithExitCode-    ) where--import Data.ByteString.Lazy.Char8 (ByteString)-import System.Exit (ExitCode)-import System.Process (CreateProcess)-import qualified System.Process.ListLike as R-import System.Process.Lazy ()--readProcess ::(a ~ ByteString) => FilePath -> [String] -> a -> IO a-readProcess = R.readProcess-readProcessWithExitCode ::(a ~ ByteString) => FilePath -> [String] -> a -> IO (ExitCode, a, a)-readProcessWithExitCode = R.readProcessWithExitCode-readCreateProcess ::(a ~ ByteString) => CreateProcess -> a -> IO a-readCreateProcess = R.readCreateProcess-readCreateProcessWithExitCode ::(a ~ ByteString) => CreateProcess -> a -> IO (ExitCode, a, a)-readCreateProcessWithExitCode = R.readCreateProcessWithExitCode
− System/Process/Chunks.hs 
@@ -1,149 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}-module System.Process.Chunks-    ( Chunk(..)-    , readProcessChunks-    -- * Control-    , foldChunk-    , foldChunks-    , putChunk-    -- * Canonical-    , canonicalChunks-    -- * Indent-    , indentChunks-    , putIndented-    -- * Dotify-    , dotifyChunk-    , dotifyChunks-    , putDots-    ) where--import Control.Applicative ((<$>), (<*>))-import Control.DeepSeq (NFData)-import Control.Monad.State (StateT, evalStateT, evalState, get, put)-import Control.Monad.Trans (lift)-import Data.List (foldl')-import Data.ListLike (ListLike(..), ListLikeIO(..))-import Data.Monoid ((<>))-import Prelude hiding (mapM, putStr, null, tail, break, sequence, length, replicate, rem)-import System.Exit (ExitCode)-import System.IO (stderr)-import System.Process (ProcessHandle, CreateProcess)-import System.Process.ListLike (ListLikePlus, readProcessInterleaved)---- | This lets us use DeepSeq's 'Control.DeepSeq.force' on the stream--- of data returned by 'readProcessChunks'.-instance NFData ExitCode---- | The output stream of a process returned by 'readProcessChunks'.-data Chunk a-    = ProcessHandle ProcessHandle -- ^ This will always come first-    | Stdout a-    | Stderr a-    | Exception IOError-    | Result ExitCode-    deriving Show---- Is this rude?  It will collide with any other bogus Show--- ProcessHandle instances created elsewhere.-instance Show ProcessHandle where-    show _ = "<processhandle>"---- | A concrete use of 'readProcessInterleaved' - build a list--- containing chunks of process output, any exceptions that get thrown--- (unimplemented), and finally an exit code.-readProcessChunks :: (ListLikePlus a c) => CreateProcess -> a -> IO [Chunk a]-readProcessChunks p input =-    readProcessInterleaved (\ h -> [ProcessHandle h]) (\ x -> [Result x]) (\ x -> [Stdout x]) (\ x -> [Stderr x]) p input--foldChunk :: (ProcessHandle -> b) -> (a -> b) -> (a -> b) -> (IOError -> b) -> (ExitCode -> b) -> Chunk a -> b-foldChunk pidf _ _ _ _ (ProcessHandle x) = pidf x-foldChunk _ outf _ _ _ (Stdout x) = outf x-foldChunk _ _ errf _ _ (Stderr x) = errf x-foldChunk _ _ _ exnf _ (Exception x) = exnf x-foldChunk _ _ _ _ exitf (Result x) = exitf x---- | Build a value from a chunk stream.-foldChunks :: (r -> Chunk a -> r) -> r -> [Chunk a] -> r-foldChunks f r0 xs = foldl' f r0 xs---- | Write the Stdout chunks to stdout and the Stderr chunks to stderr.-putChunk :: ListLikePlus a c => Chunk a -> IO ()-putChunk (Stdout x) = putStr x-putChunk (Stderr x) = hPutStr stderr x-putChunk _ = return ()---- | Merge adjacent Stdout or Stderr chunks.-canonicalChunks :: ListLikePlus a c => [Chunk a] -> [Chunk a]-canonicalChunks [] = []-canonicalChunks (Stdout a : Stdout b : more) = canonicalChunks (Stdout (a <> b) : more)-canonicalChunks (Stderr a : Stderr b : more) = canonicalChunks (Stderr (a <> b) : more)-canonicalChunks (Stdout a : more) | null a = canonicalChunks more-canonicalChunks (Stderr a : more) | null a = canonicalChunks more-canonicalChunks (a : more) = a : canonicalChunks more---- | The monad state, are we at the beginning of a line or the middle?-data BOL = BOL | MOL deriving (Eq)---- | Indent the text of a chunk with the prefixes given for stdout and--- stderr.  The state monad keeps track of whether we are at the--- beginning of a line - when we are and more text comes we insert one--- of the prefixes.-indentChunk :: forall a c m. (Monad m, Functor m, ListLikePlus a c, Eq c) => c -> a -> a -> Chunk a -> StateT BOL m [Chunk a]-indentChunk nl outp errp chunk =-    case chunk of-      Stdout x -> doText Stdout outp x-      Stderr x -> doText Stderr errp x-      _ -> return [chunk]-    where-      doText :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]-      doText con pre x = do-        let (hd, tl) = break (== nl) x-        (<>) <$> doHead con pre hd <*> doTail con pre tl-      doHead :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]-      doHead _ _ x | null x = return []-      doHead con pre x = do-        bol <- get-        case bol of-          BOL -> put MOL >> return [con (pre <> x)]-          MOL -> return [con x]-      doTail :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]-      doTail _ _ x | null x = return []-      doTail con pre x = do-        bol <- get-        put BOL-        tl <- doText con pre (tail x)-        return $ (if bol == BOL then [con pre] else []) <> [con (singleton nl)] <> tl---- | Pure function to indent the text of a chunk list.-indentChunks :: (ListLikePlus a c, Eq c) => c -> a -> a -> [Chunk a] -> [Chunk a]-indentChunks nl outp errp chunks =-    evalState (Prelude.concat <$> mapM (indentChunk nl outp errp) chunks) BOL---- | Output the indented text of a chunk list, but return the original--- unindented list.-putIndented :: (ListLikePlus a c, Eq c) => c -> a -> a -> [Chunk a] -> IO [Chunk a]-putIndented nl outp errp chunks =-    evalStateT (mapM (\ x -> indentChunk nl outp errp x >>= mapM_ (lift . putChunk) >> return x) chunks) BOL--dotifyChunk :: forall a c m. (Monad m, Functor m, ListLikePlus a c) => Int -> c -> Chunk a -> StateT Int m [Chunk a]-dotifyChunk charsPerDot dot chunk =-    case chunk of-      Stdout x -> doChars (length x)-      Stderr x -> doChars (length x)-      _ -> return [chunk]-    where-      doChars count = do-        rem <- get-        let (count', rem') = divMod (rem + count) (fromIntegral charsPerDot)-        put rem'-        if (count' > 0) then return [Stderr (replicate count' dot)] else return []--dotifyChunks :: forall a c. (ListLikePlus a c) => Int -> c -> [Chunk a] -> [Chunk a]-dotifyChunks charsPerDot dot chunks =-    evalState (Prelude.concat <$> mapM (dotifyChunk charsPerDot dot) chunks) 0---- | Output the dotified text of a chunk list, but return the original--- unindented list.-putDots :: (ListLikePlus a c) => Int -> c -> [Chunk a] -> IO [Chunk a]-putDots charsPerDot dot chunks =-    evalStateT (mapM (\ x -> dotifyChunk charsPerDot dot x >>= mapM_ (lift . putChunk) >> return x) chunks) 0
− System/Process/Lazy.hs 
@@ -1,34 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module System.Process.Lazy where--import Control.Exception as E (evaluate)-import Control.Monad-import qualified Data.ByteString.Lazy as L-import Data.List as List (map, concat)-import Data.ListLike (ListLikeIO(..))-import Data.ListLike.Text.Text ()-import Data.ListLike.Text.TextLazy ()-import qualified Data.Text as T-import qualified Data.Text.Lazy as LT-import Data.Word (Word8)-import Prelude hiding (null, length, rem)-import System.IO hiding (hPutStr, hGetContents)-import System.Process.ListLike (ListLikePlus(..))--instance ListLikePlus L.ByteString Word8 where-  setModes _ (inh, outh, errh, _) = f inh >> f outh >> f errh where f mh = maybe (return ()) (\ h -> hSetBinaryMode h True) mh-  readChunks h = hGetContents h >>= evaluate . Prelude.map (L.fromChunks . (: [])) . L.toChunks--instance ListLikePlus LT.Text Char where-  setModes _ _  = return ()-  readChunks h = hGetContents h >>= evaluate . Prelude.map (LT.fromChunks . (: [])) . LT.toChunks---- | This String instance is implemented using the Lazy Text instance.--- Otherwise (without some serious coding) String would be a strict--- instance .  Note that the 'System.Process.readProcess' in the--- process library is strict, while our equivalent is not - see test4--- in Tests/Dots.hs.-instance ListLikePlus String Char where-  setModes _ _  = return ()-  readChunks h = readChunks h >>= return . List.map T.unpack . List.concat . List.map LT.toChunks
− System/Process/ListLike.hs 
@@ -1,217 +0,0 @@--- | Generalized versions of the functions--- 'System.Process.readProcess', and--- 'System.Process.readProcessWithExitCode'.-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies #-}-module System.Process.ListLike (-  ListLikePlus(..),-  readProcessInterleaved,-  readInterleaved,-  readCreateProcessWithExitCode,-  readCreateProcess,-  readProcessWithExitCode,-  readProcess,-  showCmdSpecForUser-  ) where--import Control.Concurrent-import Control.Exception as E (SomeException, onException, catch, try, throwIO, mask, throw)-import Control.Monad-import Data.ListLike (ListLike(..), ListLikeIO(..))-import Data.ListLike.Text.Text ()-import Data.ListLike.Text.TextLazy ()-import Data.Monoid (Monoid(mempty, mappend), (<>))-import GHC.IO.Exception (IOErrorType(OtherError, ResourceVanished), IOException(ioe_type))-import Prelude hiding (null, length, rem)-import System.Exit (ExitCode(ExitSuccess, ExitFailure))-import System.IO hiding (hPutStr, hGetContents)-import qualified System.IO.Error as IO-import System.IO.Unsafe (unsafeInterleaveIO)-import System.Process (ProcessHandle, CreateProcess(..), StdStream(CreatePipe, Inherit), proc,-                       CmdSpec(RawCommand, ShellCommand), showCommandForUser,-                       createProcess, waitForProcess, terminateProcess)---- | Class of types which can be used as the input and outputs of--- these process functions.-class ListLikeIO a c => ListLikePlus a c where-  setModes :: a -> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()-  -- ^ Perform initialization on the handles returned by createProcess-  -- based on this ListLikePlus instance - typically setting binary-  -- mode on all the file descriptors if the element type is Word8.-  -- If this is not done, reading something other than text (such as a-  -- .jpg or .pdf file) will usually fail with a decoding error.-  readChunks :: Handle -> IO [a]-  -- ^ Read the list of chunks from this handle.  For lazy types this-  -- is just a call to hGetContents followed by toChunks.  For strict-  -- types it might return a singleton list.  Strings are trickier.---- | Read the output of a process and use the argument functions to--- convert it into a Monoid, preserving the order of appearance of the--- different chunks of output from standard output and standard error.-readProcessInterleaved :: (ListLikePlus a c, Monoid b) =>-                          (ProcessHandle -> b) -> (ExitCode -> b) -> (a -> b) -> (a -> b)-                       -> CreateProcess -> a -> IO b-readProcessInterleaved pidf codef outf errf p input = mask $ \ restore -> do-  hs@(Just inh, Just outh, Just errh, pid) <--      createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe })--  setModes input hs--  flip onException-    (do hClose inh; hClose outh; hClose errh;-        terminateProcess pid; waitForProcess pid) $ restore $ do-    waitOut <- forkWait $ readInterleaved (pidf pid) [(outf, outh), (errf, errh)] $ waitForProcess pid >>= return . codef-    writeInput inh input-    waitOut---- | Simultaneously read the output from several file handles, using--- the associated functions to add them to a Monoid b in the order--- they appear.  This closes each handle on EOF, because AFAIK it is--- the only useful thing to do with a file handle that has reached--- EOF.-readInterleaved :: forall a b c. (ListLikePlus a c, Monoid b) => b -> [(a -> b, Handle)] -> IO b -> IO b-readInterleaved start pairs finish = newEmptyMVar >>= readInterleaved' start pairs finish--readInterleaved' :: forall a b c. (ListLikePlus a c, Monoid b) =>-                    b -> [(a -> b, Handle)] -> IO b -> MVar (Either Handle b) -> IO b-readInterleaved' start pairs finish res = do-  mapM_ (forkIO . uncurry readHandle) pairs-  r <- takeChunks (length pairs)-  return $ start <> r-    where-      readHandle :: (a -> b) -> Handle -> IO ()-      readHandle f h = do-        cs <- readChunks h-        -- If the type returned as stdout and stderr is lazy we need-        -- to force it here in the producer thread - I'm not exactly-        -- sure why.  And why is String lazy?-        -- when (lazy (undefined :: a)) (void cs)-        mapM_ (\ c -> putMVar res (Right (f c))) cs-        hClose h-        putMVar res (Left h)-      takeChunks :: Int -> IO b-      takeChunks 0 = finish-      takeChunks openCount = takeMVar res >>= takeChunk openCount-      takeChunk :: Int -> Either Handle b -> IO b-      takeChunk openCount (Left h) = hClose h >> takeChunks (openCount - 1)-      takeChunk openCount (Right x) =-          do xs <- unsafeInterleaveIO $ takeChunks openCount-             return (x <> xs)---- | An implementation of 'System.Process.readProcessWithExitCode'--- with a two generalizations: (1) The input and outputs can be any--- instance of 'ListLikePlus', and (2) The CreateProcess is passes an--- argument, so you can use either 'System.Process.proc' or--- 'System.Process.rawSystem' and you can modify its fields such as--- 'System.Process.cwd' before the process starts-readCreateProcessWithExitCode-    :: forall a c.-       ListLikePlus a c =>-       CreateProcess   -- ^ process to run-    -> a               -- ^ standard input-    -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr, exception-readCreateProcessWithExitCode p input =-    readProcessInterleaved (\ _ -> mempty)-                           (\ c -> (c, mempty, mempty))-                           (\ x -> (mempty, x, mempty))-                           (\ x -> (mempty, mempty, x))-                           p input---- | A version of 'System.Process.readProcessWithExitCode' that uses--- any instance of 'ListLikePlus' instead of 'String', implemented--- using 'readCreateProcessWithExitCode'.-readProcessWithExitCode-    :: ListLikePlus a c =>-       FilePath                 -- ^ command to run-    -> [String]                 -- ^ any arguments-    -> a               -- ^ standard input-    -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr-readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input---- | Implementation of 'System.Process.readProcess' that uses any--- instance of 'ListLikePlus' instead of 'String', implemented using--- 'readCreateProcess'.-readProcess-    :: ListLikePlus a c =>-       FilePath                 -- ^ command to run-    -> [String]                 -- ^ any arguments-    -> a               -- ^ standard input-    -> IO a            -- ^ stdout-readProcess cmd args = readCreateProcess (proc cmd args)---- | An implementation of 'System.Process.readProcess' with a two--- generalizations: (1) The input and outputs can be any instance of--- 'ListLikePlus', and (2) The CreateProcess is passes an argument, so--- you can use either 'System.Process.proc' or--- 'System.Process.rawSystem' and you can modify its fields such as--- 'System.Process.cwd' before the process starts------ This can't be implemented by calling readProcessInterleaved because--- the std_err field needs to be set to Inherit, which means that--- 'createProcess' returns no stderr handle.  Instead, we have a--- nearly identical copy of the 'readProcessInterleaved' code which--- only passes one pair 'readInterleaved'.  REMEMBER to keep these two--- in sync if there are future changes!-readCreateProcess-    :: ListLikePlus a c =>-       CreateProcess   -- ^ process to run-    -> a               -- ^ standard input-    -> IO a            -- ^ stdout-readCreateProcess p input = mask $ \restore -> do-  hs@(Just inh, Just outh, _, pid) <--      createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit })--  setModes input hs--  flip onException-    (do hClose inh; hClose outh;-        terminateProcess pid; waitForProcess pid) $ restore $ do-    waitOut <- forkWait $ readInterleaved mempty [(id, outh)] $ waitForProcess pid >>= codef-    writeInput inh input-    waitOut--    where-      -- Throw an IO error on ExitFailure-      codef (ExitFailure r) = throw (mkError "readCreateProcess: " (cmdspec p) r)-      codef ExitSuccess = return mempty---- | Write and flush process input, closing the handle when done.--- Catch and ignore Resource Vanished exceptions, they just mean the--- process exited before all of its output was read.-writeInput :: ListLikePlus a c => Handle -> a -> IO ()-writeInput inh input = do-  (do unless (null input) (hPutStr inh input >> hFlush inh)-      hClose inh) `E.catch` resourceVanished (\ _ -> 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---- | Fork a thread to read from a handle.-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)---- | Create an exception for a process that exited abnormally.-mkError :: String -> CmdSpec -> Int -> IOError-mkError prefix (RawCommand cmd args) r =-    IO.mkIOError OtherError (prefix ++ showCommandForUser cmd args ++ " (exit " ++ show r ++ ")")-                 Nothing Nothing-mkError prefix (ShellCommand cmd) r =-    IO.mkIOError OtherError (prefix ++ cmd ++ " (exit " ++ show r ++ ")")-                 Nothing Nothing---- | A chunk stream should have an 'ExitCode' at the end, this monoid lets--- us build a monoid for the type returned by readProcessWithExitCode.-instance Monoid ExitCode where-    mempty = ExitFailure 0-    mappend x (ExitFailure 0) = x-    mappend _ x = x--showCmdSpecForUser :: CmdSpec -> String-showCmdSpecForUser (ShellCommand s) = s-showCmdSpecForUser (RawCommand p args) = showCommandForUser p args
− System/Process/Strict.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeSynonymInstances #-}--- | ListLikePlus instances for strict types - these are more--- dangerous, if you start a long running process with them they will--- block until the process finishes.  Why not try a lazy type?-{-# OPTIONS_GHC -fno-warn-orphans #-}-module System.Process.Strict where--import Control.DeepSeq (force)-import Data.ByteString.Char8 as B (ByteString)-import Data.ListLike.IO (hGetContents)-import Data.Text as T (Text)-import Data.Word (Word8)-import System.IO (hSetBinaryMode)-import System.Process.ListLike (ListLikePlus(..))--instance ListLikePlus B.ByteString Word8 where-  setModes _ (inh, outh, errh, _) = f inh >> f outh >> f errh where f mh = maybe (return ()) (\ h -> hSetBinaryMode h True) mh-  readChunks h = hGetContents h >>= return . force . (: [])--instance ListLikePlus T.Text Char where-  setModes _ _  = return ()-  readChunks h = hGetContents h >>= return . force . (: [])
− System/Process/String.hs 
@@ -1,23 +0,0 @@--- | "System.Process.ListLike" functions restricted to type 'String'.-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module System.Process.String-    ( readProcess-    , readProcessWithExitCode-    , readCreateProcess-    , readCreateProcessWithExitCode-    ) where--import System.Exit (ExitCode)-import System.Process (CreateProcess)-import qualified System.Process.ListLike as R-import System.Process.Lazy ()--readProcess :: (a ~ String) => FilePath -> [String] -> a -> IO a-readProcess = R.readProcess-readProcessWithExitCode :: (a ~ String) => FilePath -> [String] -> a -> IO (ExitCode, a, a)-readProcessWithExitCode = R.readProcessWithExitCode-readCreateProcess :: (a ~ String) => CreateProcess -> a -> IO a-readCreateProcess = R.readCreateProcess-readCreateProcessWithExitCode :: (a ~ String) => CreateProcess -> a -> IO (ExitCode, a, a)-readCreateProcessWithExitCode = R.readCreateProcessWithExitCode
− System/Process/Text.hs 
@@ -1,24 +0,0 @@--- | "System.Process.ListLike" functions restricted to type 'Data.Text.Text'.-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module System.Process.Text-    ( readProcess-    , readProcessWithExitCode-    , readCreateProcess-    , readCreateProcessWithExitCode-    ) where--import Data.Text (Text)-import System.Exit (ExitCode)-import System.Process (CreateProcess)-import qualified System.Process.ListLike as R-import System.Process.Strict ()--readProcess :: (a ~ Text) => FilePath -> [String] -> a -> IO a-readProcess = R.readProcess-readProcessWithExitCode :: (a ~ Text) => FilePath -> [String] -> a -> IO (ExitCode, a, a)-readProcessWithExitCode = R.readProcessWithExitCode-readCreateProcess :: (a ~ Text) => CreateProcess -> a -> IO a-readCreateProcess = R.readCreateProcess-readCreateProcessWithExitCode :: (a ~ Text) => CreateProcess -> a -> IO (ExitCode, a, a)-readCreateProcessWithExitCode = R.readCreateProcessWithExitCode
− System/Process/Text/Lazy.hs 
@@ -1,24 +0,0 @@--- | "System.Process.ListLike" functions restricted to the lazy 'Data.Text.Lazy.Text' type.-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module System.Process.Text.Lazy-    ( readProcess-    , readProcessWithExitCode-    , readCreateProcess-    , readCreateProcessWithExitCode-    ) where--import Data.Text.Lazy (Text)-import System.Exit (ExitCode)-import System.Process (CreateProcess)-import qualified System.Process.ListLike as R-import System.Process.Lazy ()--readProcess :: (a ~ Text) => FilePath -> [String] -> a -> IO a-readProcess = R.readProcess-readProcessWithExitCode :: (a ~ Text) => FilePath -> [String] -> a -> IO (ExitCode, a, a)-readProcessWithExitCode = R.readProcessWithExitCode-readCreateProcess :: (a ~ Text) => CreateProcess -> a -> IO a-readCreateProcess = R.readCreateProcess-readCreateProcessWithExitCode :: (a ~ Text) => CreateProcess -> a -> IO (ExitCode, a, a)-readCreateProcessWithExitCode = R.readCreateProcessWithExitCode
− Tests/Main.hs 
@@ -1,215 +0,0 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}-module Main where--import Codec.Binary.UTF8.String (encode)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import Data.ListLike as ListLike (ListLike(..))-import Data.Maybe (mapMaybe)-import Data.Monoid (Monoid(..))-import qualified Data.Text as T-import qualified Data.Text.Lazy as LT-import Prelude hiding (length, concat)-import GHC.IO.Exception-import System.Exit-import System.Posix.Files (getFileStatus, fileMode, setFileMode, unionFileModes, ownerExecuteMode, groupExecuteMode, otherExecuteMode)-import System.Process (proc)-import System.Process.Chunks (Chunk(..), readProcessChunks, canonicalChunks)-import System.Process.Lazy ()-import System.Process.ListLike (readProcessWithExitCode, readCreateProcessWithExitCode, readCreateProcess, ListLikePlus(..))-import System.Process.Strict ()-import Test.HUnit hiding (path)--fromString :: String -> B.ByteString-fromString = fromList . encode--lazyFromString :: String -> L.ByteString-lazyFromString = L.fromChunks . (: []) . fromString--instance Monoid Test where-    mempty = TestList []-    mappend (TestList a) (TestList b) = TestList (a ++ b)-    mappend (TestList a) b = TestList (a ++ [b])-    mappend a (TestList b) = TestList ([a] ++ b)-    mappend a b = TestList [a, b]--testInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test-testInstances mkTest = mappend (testCharInstances mkTest) (testWord8Instances mkTest)--testStrictInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test-testStrictInstances mkTest = mappend (testStrictCharInstances mkTest) (testStrictWord8Instances mkTest)--testLazyInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test-testLazyInstances mkTest = mappend (testLazyCharInstances mkTest) (testLazyWord8Instances mkTest)--testCharInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test-testCharInstances mkTest = mappend (testLazyCharInstances mkTest) (testStrictCharInstances mkTest)--testLazyCharInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test-testLazyCharInstances mkTest =-    TestList [ TestLabel "Lazy Text" $ mkTest LT.empty-             , TestLabel "String" $ mkTest ("" :: String) ]--testStrictCharInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test-testStrictCharInstances mkTest =-    TestList [ TestLabel "Strict Text" $ mkTest T.empty ]--testWord8Instances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test-testWord8Instances mkTest = mappend (testLazyWord8Instances mkTest) (testStrictWord8Instances mkTest)--testLazyWord8Instances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test-testLazyWord8Instances mkTest =-    TestList [ TestLabel "Lazy ByteString" $ mkTest L.empty ]--testStrictWord8Instances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test-testStrictWord8Instances mkTest =-    TestList [ TestLabel "Strict ByteString" $ mkTest B.empty ]--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--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 "[Output]" $-         TestList-         [ testCharInstances-           (\ i -> TestCase (do b <- readProcessChunks (proc "cat" ["Tests/text"]) i-                                assertEqual-                                    "UTF8"-                                    ["ProcessHandle <processhandle>",-                                     -- For Text, assuming your locale is set to utf8, the result is unicode.-                                     "Stdout \"Signed: Baishi laoren \\30333\\30707\\32769\\20154, painted in the artist\\8217s 87th year.\\n\"",-                                     "Result ExitSuccess"] (ListLike.map show (canonicalChunks b))))-         , testWord8Instances-           (\ i -> TestCase (do b <- readProcessChunks (proc "cat" ["Tests/text"]) i-                                assertEqual-                                    "UTF8"-                                    ["ProcessHandle <processhandle>",-                                     -- For ByteString we get utf8 encoded text-                                     "Stdout \"Signed: Baishi laoren \\231\\153\\189\\231\\159\\179\\232\\128\\129\\228\\186\\186, painted in the artist\\226\\128\\153s 87th year.\\n\"",-                                     "Result ExitSuccess"] (ListLike.map show (canonicalChunks b))))-         , testInstances-           (\ i -> TestCase (do b <- readProcessChunks (proc "Tests/Test1.hs" []) i-                                assertEqual-                                    "[Chunk]"-                                    ["ProcessHandle <processhandle>",-                                     "Stderr \"This is an error message.\\n\"",-                                     "Result (ExitFailure 123)"]-                                    (ListLike.map show (canonicalChunks b))))-       ]-       -- This gets "hGetContents: invalid argument (invalid byte sequence)" if we don't call-       -- binary on the file handles in readProcessInterleaved.--       , TestLabel "JPG" $-         TestList-         [ {- TestCase (do b <- readProcessChunks (proc "cat" ["Tests/houseisclean.jpg"]) B.empty >>=-                             return . mapMaybe (\ x -> case x of-                                                         Stdout s -> Just (length' s)-                                                         Stderr s -> Just (length' s)-                                                         _ -> Nothing)-                        assertEqual "ByteString Chunk Size"-                                    [68668,0]-                                    b-                                    -- If we could read a jpg file into a string the chunks would look something like this:-                                    -- [2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,1852]-                                    )-         , -}-           testLazyWord8Instances-           ( \ i -> TestCase (do b <- readProcessChunks (proc "cat" ["Tests/houseisclean.jpg"]) i >>=-                                      return . mapMaybe (\ x -> case x of-                                                                  Stdout s -> Just (length s)-                                                                  Stderr s -> Just (length s)-                                                                  _ -> Nothing)-                                 assertEqual "Chunk Size" [32752,32752,3164] b))-         , testStrictWord8Instances-           ( \ i -> TestCase (do b <- readProcessChunks (proc "cat" ["Tests/houseisclean.jpg"]) i >>=-                                      return . mapMaybe (\ x -> case x of-                                                                  Stdout s -> Just (length s)-                                                                  Stderr s -> Just (length s)-                                                                  _ -> Nothing)-                                 assertEqual "Chunk Size" [68668,0] b))-{-       -- We don't seem to get an InvalidArgument exception back.-         , TestCase (do b <- tryIOError (readProcessChunks (proc "cat" ["Tests/houseisclean.jpg"]) "") >>= return . either Left (Right . show)-                        assertEqual "String decoding exception" (Left (IOError { ioe_handle = Nothing-                                                                               , ioe_type = InvalidArgument-                                                                               , ioe_location = "recoverDecode"-                                                                               , ioe_description = "invalid byte sequence"-                                                                               , ioe_errno = Nothing-                                                                               , ioe_filename = Nothing })) b)--Related to https://ghc.haskell.org/trac/ghc/ticket/9236.  Try this:--  import System.IO-  import System.IO.Error--  main = do-    h <- openFile "Tests/houseisclean.jpg" ReadMode-    r <- try (hGetContents h) >>= either exn str-    hClose h-      where-        exn (e :: IOError) = putStrLn ("exn=" ++ show (ioe_handle e, ioe_type e, ioe_location e, ioe_description e, ioe_errno e, ioe_filename e))-        str s = putStrLn ("s=" ++ show s)--The exception gets thrown and caught after the string result starts-being printed.  You can see the open quote.--}-         ]-{--       , TestLabel "ByteString" $-         TestCase (do b <- readProcessWithExitCode "Tests/Test1.hs" [] B.empty-                      assertEqual "ByteString" (ExitFailure 123, fromString "", fromString "This is an error message.\n") b)--}-       , TestLabel "Lazy" $-         TestCase (do l <- readProcessWithExitCode "Tests/Test1.hs" [] L.empty-                      assertEqual "Lazy ByteString" (ExitFailure 123, lazyFromString "", lazyFromString "This is an error message.\n") l)-{--       , TestLabel "Text" $-         TestCase (do t <- readProcessWithExitCode "Tests/Test1.hs" [] T.empty-                      assertEqual "Text" (ExitFailure 123, T.pack "", T.pack "This is an error message.\n") t)--}-       , TestLabel "LazyText" $-         TestCase (do lt <- readProcessWithExitCode "Tests/Test1.hs" [] LT.empty-                      assertEqual "LazyText" (ExitFailure 123, LT.pack "", LT.pack "This is an error message.\n") lt)-{--       , TestLabel "String" $-         TestCase (do s <- readProcessWithExitCode "Tests/Test1.hs" [] ""-                      assertEqual "String" (ExitFailure 123, "", "This is an error message.\n") s)--}-       , TestLabel "pnmfile" $-         TestCase (do out <- L.readFile "Tests/penguin.jpg" >>=-                             readCreateProcess (proc "djpeg" []) >>=-                             readCreateProcess (proc "pnmfile" [])-                      assertEqual "pnmfile" (lazyFromString "stdin:\tPPM raw, 96 by 96  maxval 255\n") out)-       , TestLabel "pnmfile2" $-         TestCase (do jpg <- L.readFile "Tests/penguin.jpg"-                      (code1, pnm, err1) <- readCreateProcessWithExitCode (proc "djpeg" []) jpg-                      out2 <- readCreateProcess (proc "pnmfile" []) pnm-                      assertEqual "pnmfile2" (ExitSuccess, empty, 2192, 27661, lazyFromString "stdin:\tPPM raw, 96 by 96  maxval 255\n") (code1, err1, length jpg, length pnm, out2))-       , TestLabel "file closed 1" $-         TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) (lazyFromString "a" :: L.ByteString)-                      assertEqual "file closed 1" (ExitSuccess, (lazyFromString "a"), (lazyFromString "Read one character: 'a'\n")) result)-       , TestLabel "file closed 2" $-         TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) (lazyFromString "" :: L.ByteString)-                      assertEqual "file closed 2" (ExitFailure 1, empty, (lazyFromString "Test4.hs: <stdin>: hGetChar: end of file\n")) result)-       , TestLabel "file closed 3" $-         TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) ("abcde" :: LT.Text)-                      assertEqual "file closed 3" (ExitSuccess, "a", "Read one character: 'a'\n") result)-       , TestLabel "file closed 4" $-         TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) ("abcde" :: LT.Text)-                      assertEqual "file closed 4" (ExitSuccess, "a", "Read one character: 'a'\n") result)-       ])
− changelog 
@@ -1,135 +0,0 @@-haskell-process-listlike (0.9) unstable; urgency=low--  * Add an argument to readProcessInterleaved that receives the-    ProcessHandle as the process starts.  Add a corresponding constructor-    to the Output type to insert the ProcessHandle into the list-    returned by readProcessChunks.-- -- David Fox <dsf@seereason.com>  Sun, 31 Aug 2014 07:15:28 -0700--haskell-process-listlike (0.8) unstable; urgency=low--  * Replace the implementation of readCreateProcessWithExitCode-    with a call to readProcessInterleaved.  Almost did the same-    with readCreateProcess, but it was simpler to make it a near-    copy of readProcessInterleaved.-- -- David Fox <dsf@seereason.com>  Sat, 30 Aug 2014 13:08:47 -0700--haskell-process-listlike (0.7) unstable; urgency=low--  * Add module System.Process.Read.Interleaved (from process-progress)-  * Add module System.Process.Read.Chunks (from process-progress)-  * Rename module System.Process.Read.Chars -> System.Process.Read.ListLike-- -- David Fox <dsf@seereason.com>  Tue, 26 Aug 2014 11:16:13 -0700--haskell-process-listlike (0.6.2) unstable; urgency=low--  * Make changelog visible in hackage.-- -- David Fox <dsf@seereason.com>  Tue, 15 Oct 2013 07:40:46 -0700--haskell-process-listlike (0.6.1) unstable; urgency=low--  * Add System.Process.String.-- -- David Fox <dsf@seereason.com>  Wed, 22 May 2013 11:22:06 -0700--haskell-process-listlike (0.6) unstable; urgency=low--  * Use the ListLike and ListLikeIO classes as the basis of the-    class of types the readProcess functions use.-  * Move the Chunk code to the process-progress package.-- -- David Fox <dsf@seereason.com>  Wed, 28 Nov 2012 08:17:47 -0800--haskell-process-extras (0.5) unstable; urgency=low--  * Modify the signature of the readModifiedProcess* functions-    to take a CreateProcess rather than a function to modify a-    CreateProcess.-- -- David Fox <dsf@seereason.com>  Mon, 12 Nov 2012 18:37:40 -0800--haskell-process-extras (0.4.7) unstable; urgency=low--  * Add compatibility modules for the original process-extras.-- -- David Fox <dsf@seereason.com>  Wed, 24 Oct 2012 14:46:59 -0700--haskell-process-extras (0.4.6) unstable; urgency=low--  * Forked off process-progress.-- -- David Fox <dsf@seereason.com>  Wed, 24 Oct 2012 11:31:34 -0700--haskell-process-extras (0.4.5) unstable; urgency=low--  * Add Verbosity module-  * Print newline after last dot-- -- David Fox <dsf@seereason.com>  Tue, 23 Oct 2012 10:33:25 -0700--haskell-process-extras (0.4.4) unstable; urgency=low--  * Replace all the lazyCommand*/lazyProcess* functions with runProcess*.-- -- David Fox <dsf@seereason.com>  Tue, 23 Oct 2012 08:07:37 -0700--haskell-process-extras (0.4.3) unstable; urgency=low--  * More cleanups in readProcessChunks-  * Unit tests-  * Start of thread based version of readProcessChunks-  * Start of pipes based version of readProcessChunks-- -- David Fox <dsf@seereason.com>  Mon, 22 Oct 2012 16:15:14 -0700--haskell-process-extras (0.4.1) unstable; urgency=low--  * Redo and simplify readProcessChunks so it works on infinite streams without-    hanging or leaking memory.-  * Add some tests (though not in a formal framework yet.)-- -- David Fox <dsf@seereason.com>  Sat, 20 Oct 2012 15:24:15 -0700--haskell-process-extras (0.4) unstable; urgency=low--  * Re-arrange the modules so that we can generally just import-    System.Process.Read.-  * Rename readProcessChunksWithExitCode -> readProcessChunks-  * Rename class Strng -> class Chars-  * Rename class Strng2 -> class NonBlocking-- -- David Fox <dsf@seereason.com>  Thu, 18 Oct 2012 08:13:36 -0700--haskell-process-extras (0.3.8) unstable; urgency=low--  * No, we still need to catch ResourceVanished.  Ingoring it seems to-    be sufficient, don't change the signatures back to indicate when it-    happens.-- -- David Fox <dsf@seereason.com>  Wed, 17 Oct 2012 23:52:21 -0700--haskell-process-extras (0.3.7) unstable; urgency=low--  * The code that catches ResourceVanished seems to be unnecessary now,-    remove it.-- -- David Fox <dsf@seereason.com>  Wed, 17 Oct 2012 15:30:52 -0700--haskell-process-extras (0.3.6) unstable; urgency=low--  * Call hSetBinaryMode in all the ByteString instances of Strng-  * Fix a bug which prevented stderr from being forced-  * Change to emulate behavior of System.Process for input handle-- -- David Fox <dsf@seereason.com>  Wed, 17 Oct 2012 15:02:09 -0700--haskell-process-extras (0.3.5) unstable; urgency=low--  * Add instances and implementations for the String type.-- -- David Fox <dsf@seereason.com>  Wed, 17 Oct 2012 09:41:03 -0700-
process-listlike.cabal view
@@ -1,61 +1,60 @@ Name:               process-listlike-Version:            0.9-Synopsis:           Enhanced version of process-extras-Description:        Extra functionality for the Process library <http://hackage.haskell.org/package/process>.-  This is a drop-in replacement for <http://hackage.haskell.org/package/process-extras>,-  which adds support for creating processes from a CreateProcess, more access to the-  internals, and completes support for the String type.-Homepage:           http://src.seereason.com/process-listlike+Version:            0.10+Synopsis:           Process extras+Description:        Extra functionality for the Process library+                    <http://hackage.haskell.org/package/process>.+Homepage:           https://github.com/ddssff/process-listlike License:            MIT License-file:       LICENSE-Author:             David Lazar, Bas van Dijk, David Fox-Maintainer:         David Fox <dsf@seereason.com>+Author:             David Lazar, Bas van Dijk+Maintainer:         David Lazar <lazar6@illinois.edu> Category:           System Build-type:         Simple-Cabal-version:      >=1.8-Extra-Source-Files: changelog+Cabal-version:      >= 1.8+Extra-source-files:+  README.md  source-repository head-  Type:             darcs-  Location:         https://github.com/ddssff/process-listlike.git+  Type:             git+  Location:         https://github.com/ddssff/process-listlike  Library-  ghc-options:      -Wall -O2+  ghc-options:      -Wall +  Hs-source-dirs:   src+   Exposed-modules:-    System.Process.Chunks-    System.Process.Lazy-    System.Process.ListLike     System.Process.ByteString     System.Process.ByteString.Lazy-    System.Process.Strict+    System.Process.Chunks+    System.Process.ListLike+    System.Process.ListLike.Classes+    System.Process.ListLike.Instances+    System.Process.ListLike.LazyString+    System.Process.ListLike.Read+    System.Process.ListLike.ReadNoThreads+    System.Process.ListLike.StrictString     System.Process.String     System.Process.Text     System.Process.Text.Lazy +  Other-modules:+    Utils+   Build-depends:     base >= 4 && < 5,+    process,     bytestring,-    deepseq,-    HUnit,-    ListLike >= 4.0,+    ListLike >= 4,     mtl,-    process,     text,-    utf8-string+    deepseq  Executable process-listlike-tests-  Main-Is: Tests/Main.hs+  Main-Is: tests/Main.hs+  Build-depends: base >= 4, bytestring, deepseq, process, process-listlike, utf8-string, unix, text, HUnit, ListLike, regex-posix++Executable process-listlike-interactive-tests+  Main-Is: tests/Interactive.hs   GHC-Options: -Wall -O2 -threaded -rtsopts-  Build-Depends:-    base >= 4 && < 5,-    bytestring,-    deepseq,-    HUnit,-    ListLike,-    mtl,-    process,-    process-listlike,-    text,-    utf8-string,-    unix+  Build-Depends: base >= 4, bytestring, deepseq, HUnit, ListLike, mtl, process, process-listlike, text, utf8-string, unix
+ src/System/Process/ByteString.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts #-}+module System.Process.ByteString where++import Data.ByteString (ByteString)+import System.Process+import System.Process.ListLike.Classes (ProcessOutput)+import qualified System.Process.ListLike.Read as LL (readCreateProcess, readProcess)+import System.Exit (ExitCode)++readCreateProcess :: ProcessOutput ByteString b => CreateProcess -> ByteString -> IO b+readCreateProcess = LL.readCreateProcess++-- | Like 'System.Process.readProcessWithExitCode', but takes a+-- CreateProcess instead of a command and argument list, and reads and+-- writes type 'ByteString'+readCreateProcessWithExitCode+    :: CreateProcess            -- ^ command to run+    -> ByteString               -- ^ standard input+    -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr+readCreateProcessWithExitCode = LL.readCreateProcess++-- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'+readProcessWithExitCode :: FilePath -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)+readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input++-- | Like 'System.Process.readProcess', but using 'ByteString'+readProcess :: FilePath -> [String] -> ByteString -> IO ByteString+readProcess = LL.readProcess
+ src/System/Process/ByteString/Lazy.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts #-}+module System.Process.ByteString.Lazy where++import Data.ByteString.Lazy (ByteString)+import System.Exit (ExitCode)+import System.Process+import qualified System.Process.ListLike.Read as LL (readCreateProcess, readProcess)+import System.Process.ListLike.Classes (ProcessOutput)++readCreateProcess :: ProcessOutput ByteString b => CreateProcess -> ByteString -> IO b+readCreateProcess = LL.readCreateProcess++-- | Like 'System.Process.readProcessWithExitCode', but takes a+-- CreateProcess instead of a command and argument list, and reads and+-- writes type 'ByteString'+readCreateProcessWithExitCode+    :: CreateProcess            -- ^ command to run+    -> ByteString               -- ^ standard input+    -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr+readCreateProcessWithExitCode = LL.readCreateProcess++-- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'+readProcessWithExitCode :: FilePath -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)+readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input++-- | Like 'System.Process.readProcess', but using 'ByteString'+readProcess :: FilePath -> [String] -> ByteString -> IO ByteString+readProcess = LL.readProcess
+ src/System/Process/Chunks.hs view
@@ -0,0 +1,230 @@+-- | Support for using the 'Chunk' list returned by 'readProcessChunks'.+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}+module System.Process.Chunks+    ( Chunk(..)+    , readCreateProcessChunks+    , discardEmptyChunks+    , fuseChunks+    , collectProcessTriple+    , collectProcessResult+    , collectProcessOutput+    , indentChunks+    , dotifyChunks+    , putChunk+    , putMappedChunks+    , putIndented+    , putIndentedShowCommand+    , putDots+    , putDotsLn+    , insertCommandStart+    , insertCommandResult+    , insertCommandDisplay+    , showCreateProcessForUser+    , showCmdSpecForUser+    ) where++import Control.Applicative ((<$>), (<*>))+import Control.DeepSeq (NFData)+import Control.Exception (SomeException)+import Control.Monad.State (StateT, evalState, evalStateT, get, put)+import Control.Monad.Trans (lift)+import Data.ListLike (ListLike(..), ListLikeIO(hPutStr, putStr))+import Data.Monoid (Monoid, (<>), mempty)+import Data.String (IsString(fromString))+import Prelude hiding (mapM, putStr, null, tail, break, sequence, length, replicate, rem)+import System.Exit (ExitCode)+import System.IO (stderr)+import System.Process (ProcessHandle, CreateProcess(cmdspec, cwd), CmdSpec(..), showCommandForUser)+import System.Process.ListLike.Classes (ListLikeLazyIO, ProcessOutput(pidf, outf, errf, intf, codef))+import System.Process.ListLike.Read (readCreateProcess)++-- | A concrete representation of the methods in ProcessOutput.+data Chunk a+    = ProcessHandle ProcessHandle -- ^ This will always come first+    | Stdout a+    | Stderr a+    | Exception SomeException+    | Result ExitCode++instance ListLikeLazyIO a c => ProcessOutput a [Chunk a] where+    pidf p = [ProcessHandle p]+    outf x = [Stdout x]+    errf x = [Stderr x]+    intf e = [Exception e]+    codef c = [Result c]++instance ListLikeLazyIO a c => ProcessOutput a (ExitCode, [Chunk a]) where+    pidf p = (mempty, [ProcessHandle p])+    codef c = (c, mempty)+    outf x = (mempty, [Stdout x])+    errf x = (mempty, [Stderr x])+    intf e = (mempty, [Exception e])++-- | This lets us use DeepSeq's 'Control.DeepSeq.force' on a stream+-- of Chunks.+instance NFData ExitCode++-- | A concrete use of 'readCreateProcess' - build a list containing+-- chunks of process output, any exceptions that get thrown, and+-- finally an exit code.  If a is a lazy type the returned list will+-- be lazy.+readCreateProcessChunks :: (ListLikeLazyIO a c) => CreateProcess -> a -> IO [Chunk a]+readCreateProcessChunks = readCreateProcess++-- | Eliminate empty Stdout or Stderr chunks.+discardEmptyChunks :: ListLikeLazyIO a c => [Chunk a] -> [Chunk a]+discardEmptyChunks [] = []+discardEmptyChunks (Stdout a : more) | null a = discardEmptyChunks more+discardEmptyChunks (Stderr a : more) | null a = discardEmptyChunks more+discardEmptyChunks (a : more) = a : discardEmptyChunks more++-- | Merge adjacent Stdout or Stderr chunks.  This may be undesirable+-- if you want to get your input as soon as it becomes available, it+-- has the effect of making the result "less lazy".+fuseChunks :: ListLikeLazyIO a c => [Chunk a] -> [Chunk a]+fuseChunks [] = []+fuseChunks (Stdout a : Stdout b : more) = fuseChunks (Stdout (a <> b) : more)+fuseChunks (Stderr a : Stderr b : more) = fuseChunks (Stderr (a <> b) : more)+fuseChunks (Stdout a : more) | null a = fuseChunks more+fuseChunks (Stderr a : more) | null a = fuseChunks more+fuseChunks (a : more) = a : fuseChunks more++collectProcessTriple :: Monoid a => [Chunk a] -> (ExitCode, a, a)+collectProcessTriple [] = mempty+collectProcessTriple (Result x : xs) = (x, mempty, mempty) <> collectProcessTriple xs+collectProcessTriple (Stdout x : xs) = (mempty, x, mempty) <> collectProcessTriple xs+collectProcessTriple (Stderr x : xs) = (mempty, mempty, x) <> collectProcessTriple xs+collectProcessTriple (_ : xs) = collectProcessTriple xs++collectProcessResult :: Monoid a => [Chunk a] -> (ExitCode, [Chunk a])+collectProcessResult [] = mempty+collectProcessResult (Result x : xs) = (x, mempty) <> collectProcessResult xs+collectProcessResult (x : xs) = (mempty, [x]) <> collectProcessResult xs++collectProcessOutput :: Monoid a => [Chunk a] -> (ExitCode, a)+collectProcessOutput [] = mempty+collectProcessOutput (Result x : xs) = (x, mempty) <> collectProcessOutput xs+collectProcessOutput (Stdout x : xs) = (mempty, x) <> collectProcessOutput xs+collectProcessOutput (Stderr x : xs) = (mempty, x) <> collectProcessOutput xs+collectProcessOutput (_ : xs) = mempty <> collectProcessOutput xs++-- | Pure function to indent the text of a chunk list.+indentChunks :: forall a c. (ListLikeLazyIO a c, Eq c, IsString a) => String -> String -> [Chunk a] -> [Chunk a]+indentChunks outp errp chunks =+    evalState (Prelude.concat <$> mapM (indentChunk nl (fromString outp) (fromString errp)) chunks) BOL+    where+      nl :: c+      nl = Data.ListLike.head (fromString "\n" :: a)++-- | The monad state, are we at the beginning of a line or the middle?+data BOL = BOL | MOL deriving (Eq)++-- | Indent the text of a chunk with the prefixes given for stdout and+-- stderr.  The state monad keeps track of whether we are at the+-- beginning of a line - when we are and more text comes we insert one+-- of the prefixes.+indentChunk :: forall a c m. (Monad m, Functor m, ListLikeLazyIO a c, Eq c) => c -> a -> a -> Chunk a -> StateT BOL m [Chunk a]+indentChunk nl outp errp chunk =+    case chunk of+      Stdout x -> doText Stdout outp x+      Stderr x -> doText Stderr errp x+      _ -> return [chunk]+    where+      doText :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]+      doText con pre x = do+        let (hd, tl) = break (== nl) x+        (<>) <$> doHead con pre hd <*> doTail con pre tl+      doHead :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]+      doHead _ _ x | null x = return []+      doHead con pre x = do+        bol <- get+        case bol of+          BOL -> put MOL >> return [con (pre <> x)]+          MOL -> return [con x]+      doTail :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]+      doTail _ _ x | null x = return []+      doTail con pre x = do+        bol <- get+        put BOL+        tl <- doText con pre (tail x)+        return $ (if bol == BOL then [con pre] else []) <> [con (singleton nl)] <> tl++dotifyChunks :: forall a c. (ListLikeLazyIO a c) => Int -> c -> [Chunk a] -> [Chunk a]+dotifyChunks charsPerDot dot chunks =+    evalState (Prelude.concat <$> mapM (dotifyChunk charsPerDot dot) chunks) 0++-- | dotifyChunk charsPerDot dot chunk - Replaces every charsPerDot+-- characters in the Stdout and Stderr chunks with one dot.  Runs in+-- the state monad to keep track of how many characters had been seen+-- when the previous chunk finished.  chunks.+dotifyChunk :: forall a c m. (Monad m, Functor m, ListLikeLazyIO a c) => Int -> c -> Chunk a -> StateT Int m [Chunk a]+dotifyChunk charsPerDot dot chunk =+    case chunk of+      Stdout x -> doChars (length x)+      Stderr x -> doChars (length x)+      _ -> return [chunk]+    where+      doChars count = do+        rem <- get+        let (count', rem') = divMod (rem + count) (fromIntegral charsPerDot)+        put rem'+        if (count' > 0) then return [Stderr (replicate count' dot)] else return []++-- | Write the Stdout chunks to stdout and the Stderr chunks to stderr.+putChunk :: ListLikeLazyIO a c => Chunk a -> IO ()+putChunk (Stdout x) = putStr x+putChunk (Stderr x) = hPutStr stderr x+putChunk _ = return ()++-- | Apply a function to the chunk list and output the result,+-- return the original (unmodified) chunk list.+putMappedChunks :: ListLikeLazyIO a c => ([Chunk a] -> [Chunk a]) -> [Chunk a] -> IO [Chunk a]+putMappedChunks f chunks = mapM_ putChunk (f chunks) >> return chunks++-- | Output the indented text of a chunk list, but return the original+-- unindented list.+putIndented :: (ListLikeLazyIO a c, Eq c, IsString a) => String -> String -> [Chunk a] -> IO [Chunk a]+putIndented outp errp chunks = putMappedChunks (indentChunks outp errp) chunks++putIndentedShowCommand :: (ListLikeLazyIO a c, Eq c, IsString a) =>+                          CreateProcess -> String -> String -> [Chunk a] -> IO [Chunk a]+putIndentedShowCommand p outp errp chunks =+    putMappedChunks (insertCommandDisplay p . indentChunks outp errp) chunks++-- | Output the dotified text of a chunk list. Returns the original+-- (undotified) list.+putDots :: (ListLikeLazyIO a c) => Int -> c -> [Chunk a] -> IO [Chunk a]+putDots charsPerDot dot chunks =+    evalStateT (mapM (\ x -> dotifyChunk charsPerDot dot x >>= mapM_ (lift . putChunk) >> return x) chunks) 0++-- | Output the dotified text of a chunk list with a newline at EOF.+-- Returns the original list.+putDotsLn :: forall a c. (IsString a, ListLikeLazyIO a c) => Int -> c -> [Chunk a] -> IO [Chunk a]+putDotsLn cpd dot chunks = putDots cpd dot chunks >>= \ r -> hPutStr stderr (fromString "\n" :: a) >> return r++-- | Insert a chunk displaying the command and its arguments at the+-- beginning of the chunk list.+insertCommandStart :: (IsString a, ListLikeLazyIO a c, Eq c) =>+                      CreateProcess -> [Chunk a] -> [Chunk a]+insertCommandStart p chunks = [Stderr (fromString (" -> " ++ showCreateProcessForUser p ++ "\n"))] <> chunks++-- | Insert a chunk displaying the command and the result code.+insertCommandResult :: (IsString a, ListLikeLazyIO a c, Eq c) =>+                       CreateProcess -> [Chunk a] -> [Chunk a]+insertCommandResult _ [] = []+insertCommandResult p (Result code : xs) =+    Stderr (fromString (" <- " ++ show code ++ " <- " ++ showCmdSpecForUser (cmdspec p) ++ "\n")) :+    Result code :+    xs+insertCommandResult p (x : xs) = x : insertCommandResult p xs++insertCommandDisplay :: (IsString a, ListLikeLazyIO a c, Eq c) => CreateProcess -> [Chunk a] -> [Chunk a]+insertCommandDisplay p = insertCommandResult p . insertCommandStart p++showCreateProcessForUser :: CreateProcess -> String+showCreateProcessForUser p =+    showCmdSpecForUser (cmdspec p) ++ maybe "" (\ d -> " (in " ++ d ++ ")") (cwd p)++showCmdSpecForUser :: CmdSpec -> String+showCmdSpecForUser (ShellCommand s) = s+showCmdSpecForUser (RawCommand p args) = showCommandForUser p args
+ src/System/Process/ListLike.hs view
@@ -0,0 +1,8 @@+module System.Process.ListLike+    ( module System.Process.ListLike.Classes+    , module System.Process.ListLike.Read+    ) where++import System.Process.ListLike.Classes+import System.Process.ListLike.Instances ()+import System.Process.ListLike.Read
+ src/System/Process/ListLike/Classes.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}+module System.Process.ListLike.Classes+    ( ListLikeLazyIO(..)+    , ProcessOutput(..)+    ) where++import Control.Exception (SomeException)+import Data.ListLike (ListLikeIO(..))+import Data.ListLike.Text.Text ()+import Data.ListLike.Text.TextLazy ()+import Data.Monoid (Monoid(mempty, mappend))+import Prelude hiding (null, length, rem)+import System.Exit (ExitCode(ExitFailure))+import System.IO hiding (hPutStr, hGetContents)+import System.Process (ProcessHandle)++-- | Methods for turning the output of a process into a monoid.+class Monoid b => ProcessOutput a b | b -> a where+    pidf :: ProcessHandle -> b+    outf :: a -> b+    errf :: a -> b+    intf :: SomeException -> b+    codef :: ExitCode -> b++-- | A process usually has one 'ExitCode' at the end of its output, this 'Monoid'+-- instance lets us build the type returned by 'System.Process.readProcessWithExitCode'.+instance Monoid ExitCode where+    mempty = ExitFailure 0+    mappend x (ExitFailure 0) = x+    mappend _ x = x++-- | Class of types which can be used as the input and outputs of+-- these process functions.+class ListLikeIO a c => ListLikeLazyIO a c where+  readChunks :: Handle -> IO [a]+  -- ^ Read the list of chunks from this handle.  For lazy types this+  -- is just a call to 'hGetContents' followed by 'toChunks'.  For strict+  -- types it might return a singleton list.  Strings are trickier.
+ src/System/Process/ListLike/Instances.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeSynonymInstances, UndecidableInstances #-}++-- | ListLikeLazyIO instances for strict and lazy types.  If you start a+-- long running process with a strict type it will block until the+-- process finishes.  Why not try a lazy type?++{-# OPTIONS_GHC -fno-warn-orphans #-}+module System.Process.ListLike.Instances where++import Control.DeepSeq (force)+import Control.Exception as E (evaluate, throw)+import Data.ByteString.Char8 as B (ByteString)+import qualified Data.ByteString.Lazy as L+import Data.ListLike.IO (hGetContents)+import Data.Monoid (mempty)+import Data.Text as T (Text)+import qualified Data.Text.Lazy as LT+import Data.Word (Word8)+import System.Exit (ExitCode)+import System.Process.ListLike.Classes (ListLikeLazyIO(..), ProcessOutput(..))++instance ListLikeLazyIO B.ByteString Word8 where+  --setModes _ (inh, outh, errh, _) = f inh >> f outh >> f errh where f = maybe (return ()) (\ h -> hSetBinaryMode h True)+  readChunks h = hGetContents h >>= return . force . (: [])++instance ListLikeLazyIO T.Text Char where+  --setModes _ _  = return ()+  readChunks h = hGetContents h >>= return . force . (: [])++instance ListLikeLazyIO L.ByteString Word8 where+  --setModes _ (inh, outh, errh, _) = f inh >> f outh >> f errh where f = maybe (return ()) (\ h -> hSetBinaryMode h True)+  readChunks h = hGetContents h >>= evaluate . Prelude.map (L.fromChunks . (: [])) . L.toChunks++instance ListLikeLazyIO LT.Text Char where+  --setModes _ _  = return ()+  readChunks h = hGetContents h >>= evaluate . Prelude.map (LT.fromChunks . (: [])) . LT.toChunks++instance ListLikeLazyIO a c => ProcessOutput a (ExitCode, a, a) where+    pidf _ = mempty+    codef c = (c, mempty, mempty)+    outf x = (mempty, x, mempty)+    errf x = (mempty, mempty, x)+    intf e = throw e
+ src/System/Process/ListLike/LazyString.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+module System.Process.ListLike.LazyString where++import Data.Text as T (unpack)+import Data.Text.Lazy as LT (toChunks)+import System.Process.ListLike.Classes (ListLikeLazyIO(readChunks))+import System.Process.ListLike.Instances ()++-- | This String instance is implemented using the Lazy Text instance.+-- Otherwise (without some serious coding) String would be a strict+-- instance .  Note that the 'System.Process.readProcess' in the+-- process library is strict, while our equivalent is not - see test4+-- in Tests/Dots.hs.+instance ListLikeLazyIO String Char where+  readChunks h = readChunks h >>= return . map T.unpack . concat . map LT.toChunks
+ src/System/Process/ListLike/Read.hs view
@@ -0,0 +1,165 @@+-- | Generalized versions of the functions+-- 'System.Process.readProcess', and+-- 'System.Process.readProcessWithExitCode'.+{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, ScopedTypeVariables, TupleSections, TypeFamilies, UndecidableInstances #-}+module System.Process.ListLike.Read+    ( readCreateProcess,+      readCreateProcess',+      readInterleaved,+      readCreateProcessWithExitCode,+      readProcessWithExitCode,+      StdoutWrapper(..),+      readProcess+    ) where++import Control.Applicative ((<$>), (<*>), pure)+import Control.Concurrent+import Control.Exception as E (SomeException, onException, catch, mask, throw)+import Control.Monad+import Data.ListLike (ListLike(..), ListLikeIO(..))+import Data.ListLike.Text.Text ()+import Data.ListLike.Text.TextLazy ()+import Data.Maybe (maybeToList)+import Data.Monoid (Monoid(mempty, mappend), (<>))+import GHC.IO.Exception (IOErrorType(OtherError, ResourceVanished), IOException(ioe_type))+import Prelude hiding (null, length, rem)+import System.Exit (ExitCode(ExitSuccess))+import System.IO hiding (hPutStr, hGetContents)+import qualified System.IO.Error as IO+import System.IO.Unsafe (unsafeInterleaveIO)+import System.Process (CreateProcess(..), StdStream(CreatePipe, Inherit), proc,+                       createProcess, waitForProcess, terminateProcess)+import System.Process.ListLike.Classes (ListLikeLazyIO(..), ProcessOutput(..))+import System.Process.ListLike.Instances ()+import Utils (forkWait)++-- | Read the output of a process and use the argument functions to+-- convert it into a Monoid, preserving the order of appearance of the+-- different chunks of output from standard output and standard error.+readCreateProcess :: (ListLikeLazyIO a c, ProcessOutput a b) => CreateProcess -> a -> IO b+readCreateProcess  p input =+    readCreateProcess' (p {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }) input++readCreateProcess' :: (ListLikeLazyIO a c, ProcessOutput a b) => CreateProcess -> a -> IO b+readCreateProcess'  p input = mask $ \ restore -> do+  (Just inh, maybe_outh, maybe_errh, pid) <- createProcess p++  onException+    (restore $+     do -- Without unsafeIntereleaveIO the pid messsage gets stuck+        -- until some additional output arrives from the process.+        waitOut <- forkWait $ (<>) <$> pure (pidf pid)+                                   <*> unsafeInterleaveIO (readInterleaved (maybeToList (fmap (outf,) maybe_outh) <> maybeToList (fmap (errf,) maybe_errh))+                                                                           (codef <$> waitForProcess pid))+        writeInput inh input+        waitOut)+    (do terminateProcess pid+        hClose inh+        maybe (return ()) hClose maybe_outh+        maybe (return ()) hClose maybe_errh+        waitForProcess pid)++-- | Simultaneously read the output from several file handles, using+-- the associated functions to add them to a Monoid b in the order+-- they appear.  This closes each handle on EOF, because AFAIK it is+-- the only useful thing to do with a file handle that has reached+-- EOF.+readInterleaved :: forall a b c. (ListLikeLazyIO a c, ProcessOutput a b) =>+                   [(a -> b, Handle)] -> IO b -> IO b+readInterleaved pairs finish = newEmptyMVar >>= readInterleaved' pairs finish++readInterleaved' :: forall a b c. (ListLikeLazyIO a c, ProcessOutput a b) =>+                    [(a -> b, Handle)] -> IO b -> MVar (Either Handle b) -> IO b+readInterleaved' pairs finish res = do+  mapM_ (forkIO . uncurry readHandle) pairs+  takeChunks (length pairs)+    where+      -- Forked thread to read the input and send it to takeChunks via+      -- the MVar.+      readHandle :: (a -> b) -> Handle -> IO ()+      readHandle f h = do+        cs <- readChunks h+        -- If the type returned as stdout and stderr is lazy we need+        -- to force it here in the producer thread - I'm not exactly+        -- sure why.  And why is String lazy?+        -- when (lazy (undefined :: a)) (void cs)+        mapM_ (\ c -> putMVar res (Right (f c))) cs+        hClose h+        putMVar res (Left h)+      takeChunks :: Int -> IO b+      takeChunks 0 = finish+      takeChunks openCount = takeChunk >>= takeMore openCount+      takeMore :: Int -> Either Handle b -> IO b+      takeMore openCount (Left h) = hClose h >> takeChunks (openCount - 1)+      takeMore openCount (Right x) =+          do xs <- unsafeInterleaveIO $ takeChunks openCount+             return (x <> xs)+      takeChunk = takeMVar res `catch` (\ (e :: SomeException) -> return $ Right $ intf e)++-- | An implementation of 'System.Process.readProcessWithExitCode'+-- with a two generalizations: (1) The input and outputs can be any+-- instance of 'ListLikeLazyIO', and (2) The CreateProcess is passes an+-- argument, so you can use either 'System.Process.proc' or+-- 'System.Process.rawSystem' and you can modify its fields such as+-- 'System.Process.cwd' before the process starts+readCreateProcessWithExitCode :: ListLikeLazyIO a c =>+                                 CreateProcess       -- ^ process to run+                              -> a                   -- ^ standard input+                              -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr+readCreateProcessWithExitCode p input = readCreateProcess p input++-- | A version of 'System.Process.readProcessWithExitCode' that uses+-- any instance of 'ListLikeLazyIO' instead of 'String', implemented+-- using 'readCreateProcessWithExitCode'.+readProcessWithExitCode :: ListLikeLazyIO a c =>+                           FilePath            -- ^ command to run+                        -> [String]            -- ^ any arguments+                        -> a                   -- ^ standard input+                        -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr+readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input++-- | Implementation of 'System.Process.readProcess' that uses any+-- instance of 'ListLikeLazyIO' instead of 'String', implemented using+-- 'readCreateProcess'.  As with 'System.Process.readProcess', Stderr+-- goes directly to the console, only stdout is returned.  Also like+-- 'System.Process.readProcess', an IO error of type OtherError is+-- thrown when the result code is not ExitSuccess.+readProcess :: ListLikeLazyIO a c =>+               FilePath        -- ^ command to run+            -> [String]        -- ^ any arguments+            -> a               -- ^ standard input+            -> IO a            -- ^ stdout+readProcess cmd args input =+    unStdoutWrapper <$> readCreateProcess' ((proc cmd args) {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit}) input++-- | For the 'readProcess' function, we need to wrap a newtype around+-- the output type so we can build a ProcessOutput instance for it.+-- Otherwise it would overlap everything.+newtype StdoutWrapper a = StdoutWrapper {unStdoutWrapper :: a}++instance Monoid a => Monoid (StdoutWrapper a) where+    mempty = StdoutWrapper mempty+    mappend (StdoutWrapper a) (StdoutWrapper b) = StdoutWrapper (a <> b)++instance (ListLikeLazyIO a c, Monoid a) => ProcessOutput a (StdoutWrapper a) where+    pidf _ = mempty+    codef ExitSuccess = mempty+    codef failure = throw $ IO.mkIOError OtherError ("Process exited with " ++ show failure) Nothing Nothing+    outf x = StdoutWrapper x+    errf _ = mempty+    intf e = throw e++-- | Write and flush process input, closing the handle when done.+-- Catch and ignore Resource Vanished exceptions, they just mean the+-- process exited before all of its output was read.+writeInput :: ListLikeLazyIO a c => Handle -> a -> IO ()+writeInput inh input = do+  (do unless (null input) (hPutStr inh input >> hFlush inh)+      hClose inh) `E.catch` resourceVanished (\ _ -> 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
+ src/System/Process/ListLike/ReadNoThreads.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE MultiParamTypeClasses, PackageImports, ScopedTypeVariables #-}+{-# OPTIONS -Wwarn -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures #-}++-- | This is an alternative version of the module+--   "System.Process.ListLike.Read" that doesn't use forkIO.  I don't+--   know of any advantages, I'm just including it because it is derived+--   from old code I had developed, it is kinda badass, and maybe+--   someone has a use for it.+--+--   Function to run a process and return a lazy list of chunks from+--   standard output, standard error, and at the end of the list an+--   object indicating the process result code.  If neither output+--   handle is ready for reading the process sleeps and tries again,+--   with the sleep intervals increasing from 8 microseconds to a+--   maximum of 0.1 seconds.+module System.Process.ListLike.ReadNoThreads+    ( ListLikeIOPlus(..)+    , readCreateProcess+    , readCreateProcessWithExitCode+    , readProcessWithExitCode+    ) where++import Control.Applicative ((<$>), (<*>), pure)+import Control.Concurrent (threadDelay)+import Control.Exception (catch, mask, onException, try)+import Data.ListLike (ListLike(length, null), ListLikeIO(hGetNonBlocking))+import Data.Maybe (mapMaybe)+import Data.Monoid (Monoid(mempty), (<>), mconcat)+import qualified Data.Text.Lazy as LT+import Data.Text.Lazy.Encoding (encodeUtf8)+import qualified GHC.IO.Exception as E+import Prelude hiding (length, null)+import System.Exit (ExitCode)+import System.Process (ProcessHandle, CreateProcess(..), waitForProcess, proc, createProcess, StdStream(CreatePipe), terminateProcess)+import System.IO (Handle, hReady, hClose)+import System.IO.Unsafe (unsafeInterleaveIO)+import System.Process.ListLike.Classes (ProcessOutput(..), ListLikeLazyIO(..))+import System.Process.ListLike.Instances ()++-- For the ListLikeIOPlus instance+import qualified Data.ByteString.Lazy as L+import Data.Word (Word8)++-- | For the unthreaded implementation we need a more powerful+-- ListLikeLazyIO class.+class ListLikeLazyIO a c => ListLikeIOPlus a c where+    hPutNonBlocking :: Handle -> a -> IO a+    chunks :: a -> [a]++instance ListLikeIOPlus L.ByteString Word8 where+    hPutNonBlocking = L.hPutNonBlocking+    chunks = Prelude.map (L.fromChunks . (: [])) . L.toChunks++instance ListLikeIOPlus LT.Text Char where+    hPutNonBlocking h text = L.hPutNonBlocking h (encodeUtf8 text) >> return text+    chunks = map (LT.fromChunks . (: [])) . LT.toChunks++bufSize = 65536		-- maximum chunk size+uSecs = 8		-- minimum wait time, doubles each time nothing is ready+maxUSecs = 100000	-- maximum wait time (microseconds)++readCreateProcess :: forall a b c. (ListLikeIOPlus a c, ProcessOutput a b) => CreateProcess -> a -> IO b+readCreateProcess p input = mask $ \ restore -> do+    (Just inh, Just outh, Just errh, pid) <-+        createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe})++    -- setModes input hs++    -- The uses of unsafeInterleaveIO here and below are required to+    -- keep the output from blocking waiting for process exit.+    onException+      (restore $ (<>) <$> pure (pidf pid)+                      <*> (unsafeInterleaveIO $ elements pid (chunks input, Just inh, [(outf, outh), (errf, errh)], Nothing)))+      (do terminateProcess pid; hClose inh; hClose outh; hClose errh;+          waitForProcess pid)+    where+      elements :: ProcessHandle -> ([a], Maybe Handle, [(a -> b, Handle)], Maybe b) -> IO b+      -- EOF on both output descriptors, get exit code.  It can be+      -- argued that the list 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 nowhere else is a Result added.  However, the process+      -- doing the traversing might die before that end is reached.+      elements pid tuple@(_, _, [], elems) =+          do result <- try (waitForProcess pid)+             case result of+               Left exn -> (<>) <$> pure (maybe mempty id elems <> intf exn) <*> elements pid tuple+               Right code -> pure (maybe mempty id elems <> codef code)+      -- The available output has been processed, send input and read+      -- from the ready handles+      elements pid tuple@(_, _, _, Nothing) =+          do result <- try (ready uSecs tuple)+             case result of+               Left exn -> (<>) <$> pure (intf exn) <*> elements pid tuple+               Right tuple' -> elements pid tuple'+      -- Add some output to the result value+      elements pid (input, inh, pairs, Just elems) =+          (<>) <$> pure elems+               <*> (unsafeInterleaveIO $ elements pid (input, inh, pairs, Nothing))++-- A quick fix for the issue where hWaitForInput has actually started+-- raising the isEOFError exception in ghc 6.10.+data Readyness = Ready | Unready | EndOfFile deriving Eq++hReady' :: Handle -> IO Readyness+hReady' h = (hReady h >>= (\ flag -> return (if flag then Ready else Unready))) `catch` (\ (e :: IOError) ->+                                                                                             case E.ioe_type e of+                                                                                               E.EOF -> return EndOfFile+                                                                                               _ -> error (show e))++-- | Wait until at least one handle is ready and then write input or+-- read output.  Note that there is no way to check whether the input+-- handle is ready except to try to write to it and see if any bytes+-- are accepted.  If no input is accepted, or the input handle is+-- already closed, and none of the output descriptors are ready for+-- reading the function sleeps and tries again.+ready :: (ListLikeIOPlus a c, ProcessOutput a b) =>+         Int -> ([a], Maybe Handle, [(a -> b, Handle)], Maybe b)+      -> IO ([a], Maybe Handle, [(a -> b, Handle)], Maybe b)+ready waitUSecs (input, inh, pairs, elems) =+    do+      anyReady <- mapM (hReady' . snd) pairs+      case (input, inh, anyReady) of+        -- Input exhausted, close the input handle.+        ([], Just handle, _) | all (== Unready) anyReady ->+            do hClose handle+               ready  waitUSecs ([], Nothing, pairs, elems)+        -- Input handle closed and there are no ready output handles,+        -- wait a bit+        ([], Nothing, _) | all (== Unready) anyReady ->+            do threadDelay waitUSecs+               --ePut0 ("Slept " ++ show uSecs ++ " microseconds\n")+               ready (min maxUSecs (2 * waitUSecs)) (input, inh, pairs, elems)+        -- Input is available and there are no ready output handles+        (input : etc, Just handle, _)+            -- Discard a zero byte input+            | all (== Unready) anyReady && null input -> ready waitUSecs (etc, inh, pairs, elems)+            -- Send some input to the process+            | all (== Unready) anyReady ->+                do input' <- hPutNonBlocking handle input+                   case null input' of+                     -- Input buffer is full too, sleep.+                     True -> do threadDelay uSecs+                                ready (min maxUSecs (2 * waitUSecs)) (input : etc, inh, pairs, elems)+                     -- We wrote some input, discard it and continue+                     False -> return (input' : etc, Just handle, pairs, elems)+        -- One or both output handles are ready, try to read from them+        _ ->+            do allOutputs <- mapM (\ ((f, h), r) -> nextOut h r f) (zip pairs anyReady)+               let newPairs = mapMaybe (\ ((_, mh), (f, _)) -> maybe Nothing (\ h -> Just (f, h)) mh) (zip allOutputs pairs)+               return (input, inh, newPairs, elems <> mconcat (map fst allOutputs))++-- | Return the next output element and the updated handle+-- from a handle which is assumed ready.+nextOut :: (ListLikeIO a c, ProcessOutput a b) => Handle -> Readyness -> (a -> b) -> IO (Maybe b, Maybe Handle)+nextOut _ EndOfFile _ = return (Nothing, Nothing)	-- Handle is closed+nextOut handle Unready _ = return (Nothing, Just handle)	-- Handle is not ready+nextOut handle Ready constructor =	-- Perform a read+    do+      a <- hGetNonBlocking handle bufSize+      case length a of+        -- A zero length read, unlike a zero length write, always+        -- means EOF.+        0 -> do hClose handle+                return (Nothing, Nothing)+        -- Got some input+        _n -> return (Just (constructor a), Just handle)++readCreateProcessWithExitCode :: (ListLikeIOPlus a c) => CreateProcess -> a -> IO (ExitCode, a, a)+readCreateProcessWithExitCode p input = readCreateProcess p input++readProcessWithExitCode :: (ListLikeIOPlus a c) => FilePath -> [String] -> a -> IO (ExitCode, a, a)+readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input
+ src/System/Process/ListLike/StrictString.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+module System.Process.ListLike.StrictString where++import Control.DeepSeq (force)+import Data.ListLike (hGetContents)+import System.Process.ListLike.Classes (ListLikeLazyIO(readChunks))++instance ListLikeLazyIO String Char where+  readChunks h = hGetContents h >>= return . force . (: [])
+ src/System/Process/String.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE FlexibleContexts #-}+module System.Process.String where++import System.Exit (ExitCode)+import System.Process (CreateProcess(..), CmdSpec(..), readProcessWithExitCode)+import System.Process.ListLike.Classes (ProcessOutput, ListLikeLazyIO)+import System.Process.ListLike.Read as LL (readCreateProcess)++-- No ListLikeLazyIO instance is imported here because we have two and+-- naturally they conflict.+readCreateProcess :: (ListLikeLazyIO String Char, ProcessOutput String b) => CreateProcess -> String -> IO b+readCreateProcess = LL.readCreateProcess++readCreateProcessWithExitCode+    :: ListLikeLazyIO String Char =>+       CreateProcess                 -- ^ command to run+    -> String                        -- ^ standard input+    -> IO (ExitCode, String, String) -- ^ exitcode, stdout, stderr+readCreateProcessWithExitCode = LL.readCreateProcess
+ src/System/Process/Text.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts #-}+module System.Process.Text where++import Data.Text (Text)+import System.Process+import System.Process.ListLike.Classes (ProcessOutput)+import qualified System.Process.ListLike.Read as LL (readCreateProcess, readProcess)+import System.Exit (ExitCode)++readCreateProcess :: ProcessOutput Text b => CreateProcess -> Text -> IO b+readCreateProcess = LL.readCreateProcess++-- | Like 'System.Process.readProcessWithExitCode', but takes a+-- CreateProcess instead of a command and argument list, and reads and+-- writes type 'ByteString'+readCreateProcessWithExitCode+    :: CreateProcess            -- ^ command to run+    -> Text                     -- ^ standard input+    -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr+readCreateProcessWithExitCode = LL.readCreateProcess++-- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'+readProcessWithExitCode :: FilePath -> [String] -> Text -> IO (ExitCode, Text, Text)+readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input++-- | Like 'System.Process.readProcess', but using 'Text'+readProcess :: FilePath -> [String] -> Text -> IO Text+readProcess = LL.readProcess
+ src/System/Process/Text/Lazy.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleContexts #-}+module System.Process.Text.Lazy where++import Data.Text.Lazy (Text)+import System.Exit (ExitCode)+import System.Process+import System.Process.ListLike.Classes (ProcessOutput)+import qualified System.Process.ListLike.Read as LL (readCreateProcess, readProcess)++readCreateProcess :: ProcessOutput Text b => CreateProcess -> Text -> IO b+readCreateProcess = LL.readCreateProcess++-- | Like 'System.Process.readProcessWithExitCode', but using 'Text'+readCreateProcessWithExitCode+    :: CreateProcess             -- ^ command to run+    -> Text                      -- ^ standard input+    -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr+readCreateProcessWithExitCode = LL.readCreateProcess++-- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'+readProcessWithExitCode :: FilePath -> [String] -> Text -> IO (ExitCode, Text, Text)+readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input++-- | Like 'System.Process.readProcess', but using 'Text'+readProcess :: FilePath -> [String] -> Text -> IO Text+readProcess = LL.readProcess
+ src/Utils.hs view
@@ -0,0 +1,10 @@+module Utils where++import Control.Concurrent+import Control.Exception++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)
+ tests/Interactive.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving #-}+-- | Tests that require a user to send a keyboard interrupt.+module Main where++import Control.Exception (SomeException)+import qualified Data.Text.Lazy+import qualified Data.ByteString.Lazy+import Data.Monoid+import System.Process+import System.Process.Chunks (Chunk(..))+import System.Process.ListLike.Instances ()+import qualified System.Process.ListLike.ReadNoThreads as NoThreads+import qualified System.Process.ListLike.Read as Threads+import System.Environment+import System.IO+import Text.Read (readMaybe)++instance Show ProcessHandle where+    show _ = "<processhandle>"++instance Eq ProcessHandle where+    _ == _ = False++instance Eq SomeException where+    _ == _ = False++deriving instance Show a => Show (Chunk a)++deriving instance Eq a => Eq (Chunk a)++main :: IO ()+main = do+  args <- getArgs+  case readArgs args of+    Nothing ->+        hPutStrLn stderr $+          unlines ([ "usage: interactive-tests test# runner#"+                   , "tests: " ] +++                   map (\ (n, test) -> " " ++ show n ++ ". " ++ test) (zip ([1..] :: [Int]) tests) +++                   [ "runners: " ] +++                   map (\ (n, (runner, _)) -> " " ++ show n ++ ". " ++ runner) (zip ([1..] :: [Int]) runners))+    Just (test, (s, runner)) ->+        do hPutStrLn stderr (test ++ " -> " ++ s)+           runner (shell test)+    where+      readArgs :: [String] -> Maybe (String, (String, CreateProcess -> IO ()))+      readArgs [t, r] =+          case (readMaybe t, readMaybe r) of+            (Just t', Just r')+                | t' >= 1 && t' <= length tests && r' >= 1 && r' <= length runners ->+                    Just (tests !! (t' - 1), runners !! (r' - 1))+            _ -> Nothing+      readArgs _ = Nothing++tests :: [String]+tests = [ "ls -l /tmp"+        , "yes | cat -n | while read i; do echo $i; sleep 1; done"+        , "oneko"+        , "yes | cat -n" ]++runners  :: [(String, CreateProcess -> IO ())]+runners = [ ("NoThreads.readCreateProcess Lazy.Text",+             \ p -> NoThreads.readCreateProcess p mempty >>= \ (b :: [Chunk Data.Text.Lazy.Text]) ->+                    mapM_ (hPutStrLn stderr . show) b)+          , ("NoThreads.readCreateProcess Lazy.ByteString",+             \ p -> NoThreads.readCreateProcess p mempty >>= \ (b :: [Chunk Data.ByteString.Lazy.ByteString]) ->+                    mapM_ (hPutStrLn stderr . show) b)+          , ("Threads.readCreateProcess Lazy.Text",+             \ p -> Threads.readCreateProcess p mempty >>= \ (b :: [Chunk Data.Text.Lazy.Text]) ->+                    mapM_ (hPutStrLn stderr . show) b)+          , ("Threads.readCreateProcess Lazy.ByteString",+             \ p -> Threads.readCreateProcess p mempty >>= \ (b :: [Chunk Data.ByteString.Lazy.ByteString]) ->+                    mapM_ (hPutStrLn stderr . show) b)+          ]
+ tests/Main.hs view
@@ -0,0 +1,252 @@+{-# LANGUAGE CPP, FlexibleInstances, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving #-}+module Main where++import Codec.Binary.UTF8.String (encode)+import Control.Applicative ((<$>))+import Control.DeepSeq (NFData, force)+import Control.Exception (SomeException, try)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import Data.Char (chr, ord)+import Data.List (isSuffixOf)+import Data.ListLike as ListLike (ListLike(length, concat, null, groupBy, head, toList, dropWhile, takeWhile, drop, length), ListLikeIO(readFile))+import Data.Maybe (mapMaybe)+import Data.Monoid (Monoid(..), (<>))+import Data.String (IsString(fromString))+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import Prelude hiding (length, readFile, head)+import GHC.IO.Exception+import System.Exit+import System.IO (hPutStrLn, stderr)+import System.Posix.Files (getFileStatus, fileMode, setFileMode, unionFileModes, ownerExecuteMode, groupExecuteMode, otherExecuteMode)+import System.Process (CreateProcess, proc, ProcessHandle, shell, readProcessWithExitCode)+import System.Process.ByteString as B+import System.Process.ByteString.Lazy as LB+import System.Process.String as S+import System.Process.Text as T+import System.Process.Text.Lazy as LT+import System.Process.Chunks as Chunks+import System.Process.ListLike.Classes (ListLikeLazyIO, ProcessOutput)+import System.Process.ListLike.Instances+import System.Process.ListLike.StrictString () -- the lazy one is the same as lazy text, the strict one is more interesting to test+import System.Process.ListLike.Read as LL+import System.Timeout+import Test.HUnit hiding (path)+import Text.Regex.Posix ((=~))+import Text.Printf++instance Show ProcessHandle where+    show _ = "<processhandle>"++instance Eq ProcessHandle where+    _ == _ = False++instance Eq SomeException where+    _ == _ = False++deriving instance Show a => Show (Chunk a)++deriving instance Eq a => Eq (Chunk a)++instance Monoid Test where+    mempty = TestList []+    mappend (TestList a) (TestList b) = TestList (a <> b)+    mappend (TestList a) b = TestList (a <> [b])+    mappend a (TestList b) = TestList ([a] <> b)+    mappend a b = TestList [a, b]++type MkTest = forall a c. (Show a, ListLikeLazyIO a c, IsString a, Eq a, Enum c) => String -> a -> Test++testInstances :: MkTest -> Test+testInstances mkTest = mappend (testCharInstances mkTest) (testWord8Instances mkTest)++testStrictInstances :: MkTest -> Test+testStrictInstances mkTest = mappend (testStrictCharInstances mkTest) (testStrictWord8Instances mkTest)++testLazyInstances :: MkTest -> Test+testLazyInstances mkTest = mappend (testLazyCharInstances mkTest) (testLazyWord8Instances mkTest)++testCharInstances :: MkTest -> Test+testCharInstances mkTest = mappend (testLazyCharInstances mkTest) (testStrictCharInstances mkTest)++testLazyCharInstances :: MkTest -> Test+testLazyCharInstances mkTest = mkTest "Lazy Text" LT.empty++testStrictCharInstances :: MkTest -> Test+testStrictCharInstances mkTest = mappend (mkTest "Strict Text" T.empty) (mkTest "String" ("" :: String))++testWord8Instances :: MkTest -> Test+testWord8Instances mkTest = mappend (testLazyWord8Instances mkTest) (testStrictWord8Instances mkTest)++testLazyWord8Instances :: MkTest -> Test+testLazyWord8Instances mkTest = mkTest "Lazy ByteString" LB.empty++testStrictWord8Instances :: MkTest -> Test+testStrictWord8Instances mkTest = mkTest "Strict ByteString" B.empty++main :: IO ()+main =+    do chmod "tests/script1.hs"+       chmod "tests/script4.hs"+       (c,st) <- runTestText putTextToShowS test1 -- (TestList (versionTests ++ sourcesListTests ++ dependencyTests ++ changesTests))+       putStrLn (st "")+       case (failures c) + (errors c) of+         0 -> return ()+         _ -> exitFailure++chmod :: FilePath -> IO ()+chmod path =+    getFileStatus path >>= \ status ->+    setFileMode path (foldr unionFileModes (fileMode status) [ownerExecuteMode, groupExecuteMode, otherExecuteMode])++cps :: [CreateProcess]+cps = [ proc "true" []+      , proc "false" []+      , shell "foo"+      , proc "foo" []+      , shell "yes | cat -n | head 100"+      , shell "yes | cat -n"+      , proc "cat" ["tests/text"]+      , proc "cat" ["tests/houseisclean.jpg"]+      , proc "tests/script1.hs" []+      ]++test1 :: Test+test1 =+    TestLabel "test1"+      (TestList+       [ TestLabel "[Output]" $+         TestList+         [ testInstances+           (\ s i -> TestLabel s $ TestCase $ do -- We can use a string for the input because the process I/O types+                       -- are instances of IsString.+                       result <- LL.readCreateProcessWithExitCode (proc "tests/script4.hs" []) ("a" <> i)+                       assertEqual "file closed 1" (ExitSuccess, "a", "Read one character: 'a'\n") result)+         , testInstances+           (\ s i -> TestLabel s $ TestCase $ do+                       result <- LL.readCreateProcessWithExitCode (proc "tests/script4.hs" []) i+                       assertEqual "file closed 2" (ExitFailure 1, "", "script4.hs: <stdin>: hGetChar: end of file\n") result)+         , testInstances+           (\ s i -> TestLabel s $ TestCase $ do+                       result <- LL.readCreateProcessWithExitCode (proc "tests/script4.hs" []) ("abcde" <> i)+                       assertEqual "file closed 3" (ExitSuccess, "a", "Read one character: 'a'\n") result)+         , testCharInstances+           (\ s i -> TestLabel s $ TestCase $ do+                       b <- LL.readCreateProcessWithExitCode (proc "cat" ["tests/text"]) i+                       assertEqual+                         "Unicode"+                         (ExitSuccess,+                          -- For Text, assuming your locale is set to utf8, the result is unicode.+                          "Signed: Baishi laoren \30333\30707\32769\20154, painted in the artist\8217s 87th year.\n",+                          "")+                         b)+         , testWord8Instances+           (\ s i -> TestLabel s $ TestCase $ do+                       b <- LL.readCreateProcessWithExitCode (proc "cat" ["tests/text"]) i+                       assertEqual+                         "UTF8"+                         (ExitSuccess,+                          -- For ByteString we get utf8 encoded text+                          "Signed: Baishi laoren \231\153\189\231\159\179\232\128\129\228\186\186, painted in the artist\226\128\153s 87th year.\n",+                          "")+                         b)+         , testInstances+           (\ s i -> TestLabel s $ TestCase $ do+                       b <- LL.readCreateProcessWithExitCode (proc "tests/script1.hs" []) i+                       assertEqual+                         "ExitFailure"+                         (ExitFailure 123,+                          "",+                          "This is an error message.\n")+                         b)+         , testWord8Instances+           (\ s i -> TestLabel s $ TestCase $ do+                       (ex, out, err) <- LL.readCreateProcessWithExitCode (proc "cat" ["tests/houseisclean.jpg"]) i+                       assertEqual "Length" (ExitSuccess, 68668, 0) (ex, length out, length err))+         , testInstances+           (\ s i -> TestLabel s $ TestCase $ do+                       l <- LL.readCreateProcessWithExitCode (proc "tests/script1.hs" []) i+                       assertEqual "Error 123" (ExitFailure 123, "", "This is an error message.\n") l)+         , testWord8Instances+           (\ s i -> TestLabel s $ TestCase $ do+                       jpg <- readFile "tests/penguin.jpg"+                       (code1, pnm, err1) <- LL.readCreateProcessWithExitCode (proc "djpeg" []) (i <> jpg) -- force the return type of readFile to match i+                       (code2, out2, err2) <- LL.readCreateProcessWithExitCode (proc "pnmfile" []) pnm+                       assertEqual "pnmfile1"+                                   (ExitSuccess, mempty, 2192, 27661, "stdin:\tPPM raw, 96 by 96  maxval 255\n")+                                   (code1, err1, length jpg, length pnm, out2))+         , testCharInstances+           (\ s i -> TestLabel s $ TestCase $ do+                     Left e <- try $ do jpg <- readFile "tests/penguin.jpg"+                                        (code1, pnm, err1) <- LL.readCreateProcessWithExitCode (proc "djpeg" []) (i <> jpg)+                                        LL.readCreateProcessWithExitCode (proc "pnmfile" []) pnm+                     assertEqual "pnmfile2" (IOError {ioe_handle = ioe_handle e,+                                                      ioe_type = InvalidArgument,+                                                      ioe_location = "hGetContents",+                                                      ioe_description = "invalid byte sequence",+                                                      ioe_errno = Nothing,+                                                      ioe_filename = Just "tests/penguin.jpg"})+                                      (e :: IOError))+         , testInstances+           (\ s i -> TestLabel s $ TestCase $ do+                       let n = case isSuffixOf "ByteString" s of+                                 True -> (50000000 :: Int)+                                 False -> (5000000 :: Int)+                           l :: Int+                           l = case isSuffixOf "ByteString" s of+                                 True -> (539000002 :: Int)+                                 False -> (49000001 :: Int)+                       (ex, out, err) <- LL.readCreateProcessWithExitCode (proc "time" ["bash", "-c", "yes | cat -n | head -n " <> show n]) i+                       let t = parseTimeOutput err+                           v = fromInteger (toEnum l) / t+                       hPutStrLn stderr (printf "%7.2f million chars/second for " (v / 1000000.00) <> s <> " (" <> percentMessage v (expected s) <> ")")+                       let r = v `about` expected s+                       assertEqual "5M lines" (ExitSuccess, l, "Within 30% of usual speed") (ex, length out, r))+         -- This demonstrates lazy generation of process output.  If+         -- you try this with a strict instance the call to+         -- readCreateProcessChunks will block indefinitely.+         , let expected "Lazy Text" = [Stderr "..",Stderr "..",Stderr "..",Stderr "..",Stderr "..",Stderr "..",Stderr "..",Stderr "..",Stderr ".."]+               expected "Lazy ByteString" = [Stderr "................................",Stderr ".................................",+                                             Stderr ".................................",Stderr ".................................",+                                             Stderr "................................",Stderr ".................................",+                                             Stderr ".................................",Stderr ".................................",+                                             Stderr "................................"]+               expected _ = error "unexpected" in+           testLazyInstances+           (\ s i -> TestLabel s $ TestCase $ do+                       (ProcessHandle _ : chunks) <- LL.readCreateProcess (proc "bash" ["-c", "yes | cat -n"]) i >>= return . take 10 . dotifyChunks 1000 (head (i <> "."))+                       assertEqual "ten chunks" (expected s) chunks)+         , testInstances+           (\ s i -> TestLabel s $ TestCase $ do+                       hPutStrLn stderr $ "deadlock test for " ++ s+                       result <- timeout 1000000 $ print =<< LL.readProcessWithExitCode "sleep" ["2h"] i+                       assertEqual "takano-akio deadlock test" Nothing result)+         ]+       ])++expected :: String -> Double+expected "String" =             23000000.0+expected "Strict ByteString" = 760000000.0+expected "Lazy ByteString" =   760000000.0+expected "Strict Text" =        44000000.0+expected "Lazy Text" =          47000000.0+expected s = error $ "Unexpected instance: " <> show s++percentMessage v expected =+    case v / expected of+      r | r < 1.0 -> printf "%01.2f pct slower than usual" (100.0 - 100.0 * r)+      r -> printf "%01.2f pct faster than usual" (100.0 * r - 100.0)++about :: Double -> Double -> String+about v expected =+    case v / expected of+      r | r >= 0.7 && r <= 1.3 -> "Within 30% of usual speed"+      _ -> percentMessage v expected++parseTimeOutput :: forall a c. (ListLike a c, Enum c) => a -> Double+parseTimeOutput a =+    case s =~ ("^(.*)system ([0-9]*):([0-9]*).([0-9]*)elapsed(.*)$" :: String) :: (String, String, String, [String]) of+      (_, _, _, [_, m, s, h, _]) -> (read m :: Double) * 60.0 + (read s :: Double) + (read ("0." <> h) :: Double)+    where+      s = map (chr . fromEnum) $ toList a