packages feed

process-listlike 0.7 → 0.8

raw patch · 13 files changed

+272/−410 lines, 13 filesdep ~basedep ~process

Dependency ranges changed: base, process

Files

System/Process/ByteString.hs view
@@ -10,7 +10,7 @@ import Data.ByteString.Char8 (ByteString) import System.Exit (ExitCode) import System.Process (CreateProcess)-import qualified System.Process.Read as R+import qualified System.Process.ListLike as R  readProcess :: (a ~ ByteString) => FilePath -> [String] -> a -> IO a readProcess = R.readProcess
System/Process/ByteString/Lazy.hs view
@@ -10,7 +10,7 @@ import Data.ByteString.Lazy.Char8 (ByteString) import System.Exit (ExitCode) import System.Process (CreateProcess)-import qualified System.Process.Read as R+import qualified System.Process.ListLike as R  readProcess ::(a ~ ByteString) => FilePath -> [String] -> a -> IO a readProcess = R.readProcess
+ System/Process/ListLike.hs view
@@ -0,0 +1,255 @@+-- | Versions of the functions in module 'System.Process.Read' specialized for type ByteString.+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies #-}+module System.Process.ListLike (+  ListLikePlus(..),+  readProcessInterleaved,+  readInterleaved,+  readCreateProcessWithExitCode,+  readCreateProcess,+  readProcessWithExitCode,+  readProcess,+  Output(..),+  readProcessChunks+  ) where++import Control.Concurrent+import Control.DeepSeq (NFData)+import Control.Exception as E (SomeException, onException, evaluate, catch, try, throwIO, mask, throw)+import Control.Monad+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Data.Int (Int64)+import Data.List as List (map)+import Data.ListLike (ListLike(..), ListLikeIO(..))+import Data.ListLike.Text.Text ()+import Data.ListLike.Text.TextLazy ()+import Data.Monoid (Monoid(mempty, mappend), (<>))+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import Data.Word (Word8)+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 (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 the process functions.+class (Integral (LengthType a), ListLikeIO a c) => ListLikePlus a c where+  type LengthType a+  binary :: a -> [Handle] -> IO ()+  -- ^ This should call 'hSetBinaryMode' on each handle if a is a+  -- ByteString type, so that it doesn't attempt to decode the text+  -- using the current locale.+  lazy :: a -> Bool+  length' :: a -> LengthType a+  toChunks :: a -> [a]++-- | A test version of readProcessC+-- Pipes code here: http://hpaste.org/76631+readProcessInterleaved :: (ListLikePlus a c, Monoid b) =>+                          (ExitCode -> b) -> (a -> b) -> (a -> b)+                       -> CreateProcess -> a -> IO b+readProcessInterleaved codef outf errf p input = mask $ \ restore -> do+  (Just inh, Just outh, Just errh, pid) <-+      createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe })++  binary input [inh, outh, errh]++  flip onException+    (do hClose inh; hClose outh; hClose errh;+        terminateProcess pid; waitForProcess pid) $ restore $ do+    waitOut <- forkWait $ readInterleaved [(outf, outh), (errf, errh)] $ waitForProcess pid >>= return . codef+    writeInput inh input+    waitOut++-- | Simultaneously read the output from all the handles, using the+-- associated functions to add them to the Monoid b in the order they+-- appear.  Close each handle on EOF (even though they were open when+-- we received them.)  I can't think of anything else to do with a+-- handle that has reached EOF.+readInterleaved :: forall a b c. (ListLikePlus a c, Monoid b) => [(a -> b, Handle)] -> IO b -> IO b+readInterleaved pairs finish = newEmptyMVar >>= readInterleaved' pairs finish++readInterleaved' :: forall a b c. (ListLikePlus a c, Monoid 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+      readHandle f h = do+        cs <- hGetContents 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 $ force' cs)+        mapM_ (\ c -> putMVar res (Right (f c))) (toChunks 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)++-- | A polymorphic implementation of+-- 'System.Process.readProcessWithExitCode' with a few+-- generalizations:+--+--    1. The input and outputs can be any instance of 'ListLikePlus'.+--+--    2. Allows you to modify the 'CreateProcess' record before the process starts+--+--    3. Takes a 'CmdSpec', so you can launch either a 'RawCommand' or a 'ShellCommand'.+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 (\ c -> (c, mempty, mempty))+                           (\ x -> (mempty, x, mempty))+                           (\ x -> (mempty, mempty, x))+                           p input++-- | A polymorphic implementation of+-- 'System.Process.readProcessWithExitCode' in terms of+-- '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' in terms of+-- '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)++-- | A polymorphic implementation of 'System.Process.readProcess' with a few generalizations:+--+--    1. The input and outputs can be any instance of 'ListLikePlus'.+--+--    2. Allows you to modify the 'CreateProcess' record before the process starts+--+--    3. Takes a 'CmdSpec', so you can launch either a 'RawCommand' or a 'ShellCommand'.+readCreateProcess+    :: ListLikePlus a c =>+       CreateProcess   -- ^ process to run+    -> a               -- ^ standard input+    -> IO a            -- ^ stdout+readCreateProcess p input = mask $ \restore -> do+  -- Same code as readProcessInterleaved except that std_err is set+  -- to Inherit, so no errh handle is created.  Thus, only one pair+  -- exists to pass to readInterleaved.+  (Just inh, Just outh, _, pid) <-+      createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit })++  binary input [inh, outh]++  flip onException+    (do hClose inh; hClose outh;+        terminateProcess pid; waitForProcess pid) $ restore $ do+    waitOut <- forkWait $ readInterleaved [(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+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 ())++forkWait :: IO a -> IO (IO a)+forkWait a = do+  res <- newEmptyMVar+  _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res+  return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)++-- | Wrapper for a process that provides a handler for the+-- ResourceVanished exception.  This is frequently an exception we+-- wish to ignore, because many processes will deliberately exit+-- before they have read all of their input.+resourceVanished :: (IOError -> IO a) -> IOError -> IO a+resourceVanished epipe e = if ioe_type e == ResourceVanished then epipe e else ioError e++-- | 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++force' :: forall a c. ListLikePlus a c => a -> IO (LengthType a)+force' x = evaluate $ length' $ x++instance ListLikePlus String Char where+  type LengthType String = Int+  binary _ = mapM_ (\ h -> hSetBinaryMode h True) -- Prevent decoding errors when reading handles (because internally this uses lazy bytestrings)+  lazy _ = True  -- Why True?  toChunks returns a singleton?+  length' = length+  toChunks = (: [])++instance ListLikePlus B.ByteString Word8 where+  type LengthType B.ByteString = Int+  binary _ = mapM_ (\ h -> hSetBinaryMode h True) -- Prevent decoding errors when reading handles+  lazy _ = False+  length' = B.length+  toChunks = (: [])++instance ListLikePlus L.ByteString Word8 where+  type LengthType L.ByteString = Int64+  binary _ = mapM_ (\ h -> hSetBinaryMode h True) -- Prevent decoding errors when reading handles+  lazy _ = True+  length' = L.length+  toChunks = List.map (L.fromChunks . (: [])) . L.toChunks++instance ListLikePlus T.Text Char where+  type LengthType T.Text = Int+  binary _ _ = return ()+  lazy _ = False+  length' = T.length+  toChunks = (: [])++instance ListLikePlus LT.Text Char where+  type LengthType LT.Text = Int64+  binary _ _ = return ()+  lazy _ = True+  length' = LT.length+  toChunks = List.map (LT.fromChunks . (: [])) . LT.toChunks++instance Monoid ExitCode where+    mempty = ExitFailure 0+    mappend x (ExitFailure 0) = x+    mappend _ x = x++-- | This lets us use deepseq's force on the stream of data returned+-- by readProcessChunks.+instance NFData ExitCode++data Output a = Stdout a | Stderr a | Result ExitCode | Exception IOError deriving (Eq, Show)++readProcessChunks :: (ListLikePlus a c) => CreateProcess -> a -> IO [Output a]+readProcessChunks p input =+    readProcessInterleaved (\ x -> [Result x]) (\ x -> [Stdout x]) (\ x -> [Stderr x]) p input
− System/Process/Read.hs 
@@ -1,16 +0,0 @@-module System.Process.Read-    ( ListLikePlus(..)-    , readCreateProcessWithExitCode-    , readCreateProcess-    , readProcessWithExitCode-    , readProcess-    , Chunked(..)-    , readProcessInterleaved-    , readInterleaved-    , Output(..)-    , readProcessChunks-    ) where--import System.Process.Read.Chunks-import System.Process.Read.ListLike-import System.Process.Read.Interleaved
− System/Process/Read/Chunks.hs 
@@ -1,19 +0,0 @@-module System.Process.Read.Chunks-    ( Output(..)-    , readProcessChunks-    ) where--import Control.DeepSeq (NFData)-import System.Exit (ExitCode)-import System.Process (CreateProcess)-import System.Process.Read.Interleaved---- | This lets us use deepseq's force on the stream of data returned--- by readProcessChunks.-instance NFData ExitCode--data Output a = Stdout a | Stderr a | Result ExitCode | Exception IOError deriving (Eq, Show)--readProcessChunks :: (Chunked a c) => CreateProcess -> a -> IO [Output a]-readProcessChunks p input =-    readProcessInterleaved (\ x -> [Result x]) (\ x -> [Stdout x]) (\ x -> [Stderr x]) p input
− System/Process/Read/Interleaved.hs 
@@ -1,117 +0,0 @@--- | Read the output of several file descriptors concurrently,--- preserving the order in which the chunks are read.-{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances #-}-{-# OPTIONS_GHC -Wall #-}-module System.Process.Read.Interleaved-    ( Chunked(..)-    , readProcessInterleaved-    , readInterleaved-    ) where--import Control.Concurrent (forkIO, MVar, newEmptyMVar, putMVar, takeMVar)-import Control.Exception as E (onException, catch, mask, try, throwIO, SomeException)-import Control.Monad (unless)-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Lazy as ByteString.Lazy-import Data.List as List (map)-import Data.ListLike (ListLike(..), ListLikeIO(..))-import Data.Monoid (Monoid, (<>))-import Data.Text (Text)-import qualified Data.Text.Lazy as Text.Lazy (Text, toChunks, fromChunks)-import Data.Word (Word8)-import GHC.IO.Exception (IOErrorType(ResourceVanished), IOException(ioe_type))-import Prelude hiding (null, length, rem)-import System.Exit (ExitCode)-import System.IO hiding (hPutStr, hGetContents)-import System.IO.Unsafe (unsafeInterleaveIO)-import System.Process (CreateProcess(..), StdStream(CreatePipe),-                       createProcess, waitForProcess, terminateProcess)-import System.Process.Read.ListLike (ListLikePlus(..))---- | Class of types which can also be used by 'System.Process.Read.readProcessChunks'.-class ListLikePlus a c => Chunked a c where-  toChunks :: a -> [a]--instance Chunked ByteString.Lazy.ByteString Word8 where-  toChunks = List.map (ByteString.Lazy.fromChunks . (: [])) . ByteString.Lazy.toChunks---- I have to assume that this is not prone to utf8 decode errors.--- When I was converting lazy ByteStrings to Text  I sometimes got--- such errors when a chunk ended in the middle of a unicode char.-instance Chunked Text.Lazy.Text Char where-  toChunks = List.map (Text.Lazy.fromChunks . (: [])) . Text.Lazy.toChunks---- Note that the instances that use @toChunks = (: [])@ put everything--- into a single chunk - lazy reading won't work with these types.-instance Chunked ByteString.ByteString Word8 where-  toChunks = (: [])--instance Chunked String Char where-  toChunks = (: [])--instance Chunked Data.Text.Text Char where-  toChunks = (: [])---- | A test version of readProcessC--- Pipes code here: http://hpaste.org/76631-readProcessInterleaved :: (Chunked a c, Monoid b) =>-                          (ExitCode -> b) -> (a -> b) -> (a -> b)-                       -> CreateProcess -> a -> IO b-readProcessInterleaved codef outf errf p input = mask $ \ restore -> do-  (Just inh, Just outh, Just errh, pid) <--      createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe })--  binary input [inh, outh, errh]--  flip onException-    (do hClose inh; hClose outh; hClose errh;-        terminateProcess pid; waitForProcess pid) $ restore $ do--    waitOut <- forkWait $ readInterleaved [(outf, outh), (errf, errh)] $ waitForProcess pid >>= return . codef--    -- now write and flush any input-    (do unless (null input) (hPutStr inh input >> hFlush inh)-        hClose inh) `catch` resourceVanished (\ _e -> return ())--    -- wait on the output-    waitOut---- | Simultaneously read the output from all the handles, using the--- associated functions to add them to the Monoid b in the order they--- appear.  Close each handle on EOF (even though they were open when--- we received them.)-readInterleaved :: forall a b c. (Chunked a c, Monoid b) => [(a -> b, Handle)] -> IO b -> IO b-readInterleaved pairs finish = newEmptyMVar >>= readInterleaved' pairs finish--readInterleaved' :: forall a b c. (Chunked a c, Monoid 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-      readHandle f h = do-        cs <- hGetContents h-        mapM_ (\ c -> putMVar res (Right (f c))) (toChunks 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)--forkWait :: IO a -> IO (IO a)-forkWait a = do-  res <- newEmptyMVar-  _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res-  return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)---- | Wrapper for a process that provides a handler for the--- ResourceVanished exception.  This is frequently an exception we--- wish to ignore, because many processes will deliberately exit--- before they have read all of their input.-resourceVanished :: (IOError -> IO a) -> IOError -> IO a-resourceVanished epipe e = if ioe_type e == ResourceVanished then epipe e else ioError e
− System/Process/Read/ListLike.hs 
@@ -1,247 +0,0 @@--- | Versions of the functions in module 'System.Process.Read' specialized for type ByteString.-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies #-}-module System.Process.Read.ListLike (-  ListLikePlus(..),-  readCreateProcessWithExitCode,-  readCreateProcess,-  readProcessWithExitCode,-  readProcess,-  ) where--import Control.Concurrent-import Control.Exception as E (SomeException, onException, evaluate, catch, try, throwIO, mask)-import Control.Monad-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import Data.Int (Int64)-import Data.ListLike (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 GHC.IO.Exception (IOErrorType(OtherError, ResourceVanished), IOException(ioe_type))-import Prelude hiding (null, length)-import System.Exit (ExitCode(ExitSuccess, ExitFailure))-import System.IO hiding (hPutStr, hGetContents)-import qualified System.IO.Error as IO-import System.Process (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 the process functions.-class (Integral (LengthType a), ListLikeIO a c) => ListLikePlus a c where-  type LengthType a-  binary :: a -> [Handle] -> IO ()-  -- ^ This should call 'hSetBinaryMode' on each handle if a is a-  -- ByteString type, so that it doesn't attempt to decode the text-  -- using the current locale.-  lazy :: a -> Bool-  length' :: a -> LengthType a---- | A polymorphic implementation of--- 'System.Process.readProcessWithExitCode' with a few--- generalizations:------    1. The input and outputs can be any instance of 'ListLikePlus'.------    2. Allows you to modify the 'CreateProcess' record before the process starts------    3. Takes a 'CmdSpec', so you can launch either a 'RawCommand' or a 'ShellCommand'.-readCreateProcessWithExitCode-    :: forall a c.-       ListLikePlus a c =>-       CreateProcess   -- ^ process to run-    -> a               -- ^ standard input-    -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr, exception-#if 1-readCreateProcessWithExitCode p input =-    readProcessInterleaved p input (\ a -> (a, mempty, mempty))-                                   (\ a -> (mempty, a, mempty))-                                   (\ code -> (mempty, mempty, code))--instance forall a c. ListLikePlus a c => Monoid (a, a, ExitCode) where-    mempty = (mempty, mempty, ExitFailure 0)-    mappend (a, b, c) (d, e, f) = (mappend a d, mappend b e, mappend c f)--instance Monoid ExitCode where-    mempty = ExitFailure 0 -- A hack, but this should not occur.-    mappend x (ExitFailure 0) = x-    mappend _ x = x--#else-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 hClose inh; hClose outh; hClose errh;-          terminateProcess pid; waitForProcess pid) $ restore $ do-      (out, err) <- (if lazy input then readLazy else readStrict) inh outh errh--      hClose outh-      hClose errh--      -- wait on the process-      ex <- waitForProcess pid--      return (ex, out, err)-    where-      readLazy :: Handle -> Handle -> Handle -> IO (a, a)-      readLazy inh outh errh =-           do out <- hGetContents outh-              waitOut <- forkWait $ void $ force $ out-              err <- hGetContents errh-              waitErr <- forkWait $ void $ force $ err-              -- now write and flush any input-              writeInput inh-              -- wait on the output-              waitOut-              waitErr-              return (out, err)--      readStrict :: Handle -> Handle -> Handle -> IO (a, a)-      readStrict inh outh errh =-           do -- fork off a thread to start consuming stdout-              waitOut <- forkWait $ hGetContents outh-              -- fork off a thread to start consuming stderr-              waitErr <- forkWait $ hGetContents errh-              -- now write and flush any input-              writeInput inh-              -- wait on the output-              out <- waitOut-              err <- waitErr-              return (out, err)--      writeInput :: Handle -> IO ()-      writeInput inh = do-        (do unless (null input) (hPutStr inh input >> hFlush inh)-            hClose inh) `E.catch` resourceVanished (\ _ -> return ())-#endif---- | A polymorphic implementation of--- 'System.Process.readProcessWithExitCode' in terms of--- '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' in terms of--- '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)---- | A polymorphic implementation of 'System.Process.readProcess' with a few generalizations:------    1. The input and outputs can be any instance of 'ListLikePlus'.------    2. Allows you to modify the 'CreateProcess' record before the process starts------    3. Takes a 'CmdSpec', so you can launch either a 'RawCommand' or a 'ShellCommand'.-readCreateProcess-    :: ListLikePlus a c =>-       CreateProcess   -- ^ process to run-    -> a               -- ^ standard input-    -> IO a            -- ^ stdout-#if 0-readCreateProcess p input = readProcessInterleaved (\ x -> x) (\ _ -> mempty) (\ _ -> mempty) p input-#else-readCreateProcess p input = mask $ \restore -> do-    (Just inh, Just outh, _, pid) <--        createProcess (p {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit })--    flip onException-      (do hClose inh; hClose outh;-          terminateProcess pid; waitForProcess pid) $ restore $ do-      out <- (if lazy input then readLazy else readStrict) inh outh--      hClose outh--      -- wait on the process-      ex <- waitForProcess pid--      case ex of-        ExitSuccess   -> return out-        ExitFailure r -> ioError (mkError "readCreateProcess: " (cmdspec p) r)-    where-      readLazy inh outh =-          do -- fork off a thread to start consuming stdout-             out <- hGetContents outh-             waitOut <- forkWait $ void $ force $ out-             writeInput inh-             waitOut-             return out--      readStrict inh outh =-          do waitOut <- forkWait $ hGetContents outh-             writeInput inh-             waitOut--      writeInput inh = do-         (do unless (null input) (hPutStr inh input >> hFlush inh)-             hClose inh) `E.catch` resourceVanished (\ _ -> return ())-#endif--forkWait :: IO a -> IO (IO a)-forkWait a = do-  res <- newEmptyMVar-  _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res-  return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)---- | Wrapper for a process that provides a handler for the--- ResourceVanished exception.  This is frequently an exception we--- wish to ignore, because many processes will deliberately exit--- before they have read all of their input.-resourceVanished :: (IOError -> IO a) -> IOError -> IO a-resourceVanished epipe e = if ioe_type e == ResourceVanished then epipe e else ioError e---- | 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--force :: forall a c. ListLikePlus a c => a -> IO (LengthType a)-force x = evaluate $ length' $ x--instance ListLikePlus String Char where-  type LengthType String = Int-  binary _ = mapM_ (\ h -> hSetBinaryMode h True) -- Prevent decoding errors when reading handles (because internally this uses lazy bytestrings)-  lazy _ = True-  length' = length--instance ListLikePlus B.ByteString Word8 where-  type LengthType B.ByteString = Int-  binary _ = mapM_ (\ h -> hSetBinaryMode h True) -- Prevent decoding errors when reading handles-  lazy _ = False-  length' = B.length--instance ListLikePlus L.ByteString Word8 where-  type LengthType L.ByteString = Int64-  binary _ = mapM_ (\ h -> hSetBinaryMode h True) -- Prevent decoding errors when reading handles-  lazy _ = True-  length' = L.length--instance ListLikePlus T.Text Char where-  type LengthType T.Text = Int-  binary _ _ = return ()-  lazy _ = False-  length' = T.length--instance ListLikePlus LT.Text Char where-  type LengthType LT.Text = Int64-  binary _ _ = return ()-  lazy _ = True-  length' = LT.length
System/Process/String.hs view
@@ -9,7 +9,7 @@  import System.Exit (ExitCode) import System.Process (CreateProcess)-import qualified System.Process.Read as R+import qualified System.Process.ListLike as R  readProcess :: (a ~ String) => FilePath -> [String] -> a -> IO a readProcess = R.readProcess
System/Process/Text.hs view
@@ -10,7 +10,7 @@ import Data.Text (Text) import System.Exit (ExitCode) import System.Process (CreateProcess)-import qualified System.Process.Read as R+import qualified System.Process.ListLike as R  readProcess :: (a ~ Text) => FilePath -> [String] -> a -> IO a readProcess = R.readProcess
System/Process/Text/Lazy.hs view
@@ -10,7 +10,7 @@ import Data.Text.Lazy (Text) import System.Exit (ExitCode) import System.Process (CreateProcess)-import qualified System.Process.Read as R+import qualified System.Process.ListLike as R  readProcess :: (a ~ Text) => FilePath -> [String] -> a -> IO a readProcess = R.readProcess
Tests/Main.hs view
@@ -10,7 +10,7 @@ import System.Exit import System.Posix.Files (getFileStatus, fileMode, setFileMode, unionFileModes, ownerExecuteMode, groupExecuteMode, otherExecuteMode) import System.Process (proc)-import System.Process.Read (readProcessWithExitCode, readCreateProcessWithExitCode, readCreateProcess, ListLikePlus(..))+import System.Process.ListLike (readProcessWithExitCode, readCreateProcessWithExitCode, readCreateProcess, ListLikePlus(..)) import Test.HUnit hiding (path)  fromString :: String -> B.ByteString
changelog view
@@ -1,3 +1,12 @@+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)
process-listlike.cabal view
@@ -1,5 +1,5 @@ Name:               process-listlike-Version:            0.7+Version:            0.8 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>,@@ -23,10 +23,7 @@   ghc-options:      -Wall -O2    Exposed-modules:-    System.Process.Read-    System.Process.Read.Chunks-    System.Process.Read.Interleaved-    System.Process.Read.ListLike+    System.Process.ListLike     System.Process.ByteString     System.Process.ByteString.Lazy     System.Process.String