packages feed

process-listlike 0.10 → 1.0

raw patch · 17 files changed

+176/−1123 lines, 17 filesdep −HUnitdep −mtldep −process-listlikedep ~ListLikedep ~basedep ~bytestring

Dependencies removed: HUnit, mtl, process-listlike, regex-posix, unix, utf8-string

Dependency ranges changed: ListLike, base, bytestring, process

Files

process-listlike.cabal view
@@ -1,16 +1,16 @@ Name:               process-listlike-Version:            0.10+Version:            1.0 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-Maintainer:         David Lazar <lazar6@illinois.edu>+Author:             David Lazar, Bas van Dijk, David Fox+Maintainer:         David Fox <dsf@seereason.com> Category:           System Build-type:         Simple-Cabal-version:      >= 1.8+Cabal-version:      >=1.6 Extra-source-files:   README.md @@ -26,15 +26,8 @@   Exposed-modules:     System.Process.ByteString     System.Process.ByteString.Lazy-    System.Process.Chunks+    System.Process.Extras     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 @@ -43,18 +36,8 @@    Build-depends:     base >= 4 && < 5,+    ListLike >= 4,     process,     bytestring,-    ListLike >= 4,-    mtl,     text,     deepseq--Executable process-listlike-tests-  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, bytestring, deepseq, HUnit, ListLike, mtl, process, process-listlike, text, utf8-string, unix
src/System/Process/ByteString.hs view
@@ -1,28 +1,27 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.ByteString where +import Control.Exception+import Control.Monad import Data.ByteString (ByteString)+import Data.ListLike (null)+import Data.ListLike.IO (hGetContents, hPutStr)+import Data.Word (Word8)+import Prelude hiding (null) import System.Process-import System.Process.ListLike.Classes (ProcessOutput)-import qualified System.Process.ListLike.Read as LL (readCreateProcess, readProcess)+import qualified System.Process.ListLike as LL 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+import System.IO (hClose, hFlush)+import Utils (forkWait)  -- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'+instance LL.ListLikeProcessIO ByteString Word8 where+    forceOutput = return++-- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)-readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input+readProcessWithExitCode = LL.readProcessWithExitCode --- | Like 'System.Process.readProcess', but using 'ByteString'-readProcess :: FilePath -> [String] -> ByteString -> IO ByteString-readProcess = LL.readProcess+readCreateProcessWithExitCode :: CreateProcess -> ByteString -> IO (ExitCode, ByteString, ByteString)+readCreateProcessWithExitCode = LL.readCreateProcessWithExitCode
src/System/Process/ByteString/Lazy.hs view
@@ -1,28 +1,29 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.ByteString.Lazy where +import Control.DeepSeq (force)+import Control.Exception+import qualified Control.Exception as C (evaluate)+import Control.Monad import Data.ByteString.Lazy (ByteString)-import System.Exit (ExitCode)+import Data.ListLike (null)+import Data.ListLike.IO (hGetContents, hPutStr)+import Data.Word (Word8)+import Prelude hiding (null) 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+import qualified System.Process.ListLike as LL+import System.Exit (ExitCode)+import System.IO (hClose, hFlush)+import Utils (forkWait)  -- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'+instance LL.ListLikeProcessIO ByteString Word8 where+    forceOutput = C.evaluate . force++-- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)-readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input+readProcessWithExitCode = LL.readProcessWithExitCode --- | Like 'System.Process.readProcess', but using 'ByteString'-readProcess :: FilePath -> [String] -> ByteString -> IO ByteString-readProcess = LL.readProcess+readCreateProcessWithExitCode :: CreateProcess -> ByteString -> IO (ExitCode, ByteString, ByteString)+readCreateProcessWithExitCode = LL.readCreateProcessWithExitCode
− src/System/Process/Chunks.hs 
@@ -1,230 +0,0 @@--- | 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/Extras.hs view
@@ -0,0 +1,40 @@+-- | Re-export all symbols and instances of the process-extras package.+{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, UndecidableInstances #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+module System.Process.Extras+    ( ListLikeProcessIO(forceOutput)+    , readCreateProcessWithExitCode+    , readProcessWithExitCode+    , showCreateProcessForUser+    , showCmdSpecForUser+    ) where++import Control.DeepSeq (force)+import qualified Control.Exception as C (evaluate)+-- import Data.Text (pack, unpack)+import System.Process (CmdSpec(..), CreateProcess(..), showCommandForUser)+import System.Process.ByteString ()+import System.Process.ByteString.Lazy ()+import System.Process.ListLike (ListLikeProcessIO(forceOutput), readCreateProcessWithExitCode, readProcessWithExitCode)+import System.Process.Text ()+import System.Process.Text.Lazy ()++-- | System.Process utility functions.+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++-- | Like 'System.Process.readProcessWithExitCode' that takes a 'CreateProcess'.+instance ListLikeProcessIO String Char where+    -- This is required because strings are magically lazy.  Without it+    -- processes get exit status 13 - file read failures.+    forceOutput = C.evaluate . force+{-+  readCreateProcessWithExitCode p input = do+    (code, out, err) <- readCreateProcessWithExitCode p (pack input)+    return (code, unpack out, unpack err)+-}
src/System/Process/ListLike.hs view
@@ -1,8 +1,56 @@-module System.Process.ListLike-    ( module System.Process.ListLike.Classes-    , module System.Process.ListLike.Read-    ) where+{-# LANGUAGE MultiParamTypeClasses #-}+module System.Process.ListLike where -import System.Process.ListLike.Classes-import System.Process.ListLike.Instances ()-import System.Process.ListLike.Read+import Control.Exception+import Control.Monad+import Data.ListLike (null)+import Data.ListLike.IO (ListLikeIO, hGetContents, hPutStr)+import Prelude hiding (null)+import System.Exit (ExitCode)+import System.IO (hClose, hFlush)+import System.Process+import Utils (forkWait)++class ListLikeIO a c => ListLikeProcessIO a c where+    forceOutput :: a -> IO a++-- | Like 'System.Process.readProcessWithExitCode', but with generalized input and output type.+readProcessWithExitCode+    :: ListLikeProcessIO 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++readCreateProcessWithExitCode :: ListLikeProcessIO a c => CreateProcess -> a -> IO (ExitCode, a, a)+readCreateProcessWithExitCode p input = mask $ \restore -> do+    (Just inh, Just outh, Just errh, pid) <-+        createProcess p{ std_in  = CreatePipe,+                                       std_out = CreatePipe,+                                       std_err = CreatePipe }+    flip onException+      (do terminateProcess pid; hClose inh; hClose outh; hClose errh;+          waitForProcess pid) $ restore $ do++      -- fork off a thread to start consuming stdout+      waitOut <- forkWait $ hGetContents outh >>= forceOutput++      -- fork off a thread to start consuming stderr+      waitErr <- forkWait $ hGetContents errh >>= forceOutput++      -- now write and flush any input+      unless (null input) $ do hPutStr inh input; hFlush inh+      hClose inh -- done with stdin++      -- wait on the output+      out <- waitOut+      err <- waitErr++      hClose outh+      hClose errh++      -- wait on the process+      ex <- waitForProcess pid++      return (ex, out, err)
− src/System/Process/ListLike/Classes.hs 
@@ -1,38 +0,0 @@-{-# 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 
@@ -1,43 +0,0 @@-{-# 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 
@@ -1,15 +0,0 @@-{-# 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 
@@ -1,165 +0,0 @@--- | 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 
@@ -1,173 +0,0 @@-{-# 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 
@@ -1,9 +0,0 @@-{-# 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 
@@ -1,19 +0,0 @@-{-# 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
@@ -1,28 +1,26 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Text where +import Control.Exception+import Control.Monad import Data.Text (Text)+import Data.ListLike (null)+import Data.ListLike.IO (hGetContents, hPutStr)+import Prelude hiding (null) import System.Process-import System.Process.ListLike.Classes (ProcessOutput)-import qualified System.Process.ListLike.Read as LL (readCreateProcess, readProcess)+import qualified System.Process.ListLike as LL import System.Exit (ExitCode)--readCreateProcess :: ProcessOutput Text b => CreateProcess -> Text -> IO b-readCreateProcess = LL.readCreateProcess+import System.IO (hClose, hFlush)+import Utils (forkWait) --- | 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 'Text'+instance LL.ListLikeProcessIO Text Char where+    forceOutput = return --- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'+-- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -> [String] -> Text -> IO (ExitCode, Text, Text)-readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input+readProcessWithExitCode = LL.readProcessWithExitCode --- | Like 'System.Process.readProcess', but using 'Text'-readProcess :: FilePath -> [String] -> Text -> IO Text-readProcess = LL.readProcess+readCreateProcessWithExitCode :: CreateProcess -> Text -> IO (ExitCode, Text, Text)+readCreateProcessWithExitCode = LL.readCreateProcessWithExitCode
src/System/Process/Text/Lazy.hs view
@@ -1,26 +1,28 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Text.Lazy where +import Control.DeepSeq (force)+import Control.Exception+import qualified Control.Exception as C (evaluate)+import Control.Monad+import Data.ListLike (null)+import Data.ListLike.IO (hGetContents, hPutStr) import Data.Text.Lazy (Text)-import System.Exit (ExitCode)+import Prelude hiding (null) 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+import qualified System.Process.ListLike as LL+import System.Exit (ExitCode)+import System.IO (hClose, hFlush)+import Utils (forkWait)  -- | 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+instance LL.ListLikeProcessIO Text Char where+    forceOutput = C.evaluate . force --- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'+-- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -> [String] -> Text -> IO (ExitCode, Text, Text)-readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input+readProcessWithExitCode = LL.readProcessWithExitCode --- | Like 'System.Process.readProcess', but using 'Text'-readProcess :: FilePath -> [String] -> Text -> IO Text-readProcess = LL.readProcess+readCreateProcessWithExitCode :: CreateProcess -> Text -> IO (ExitCode, Text, Text)+readCreateProcessWithExitCode = LL.readCreateProcessWithExitCode
− tests/Interactive.hs 
@@ -1,74 +0,0 @@-{-# 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 
@@ -1,252 +0,0 @@-{-# 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