process-extras 0.2.0 → 0.3.0
raw patch · 7 files changed
+315/−164 lines, 7 filesdep +ListLikedep ~basedep ~bytestringdep ~processnew-uploader
Dependencies added: ListLike
Dependency ranges changed: base, bytestring, process
Files
- process-extras.cabal +8/−5
- src/System/Process/ByteString.hs +15/−37
- src/System/Process/ByteString/Lazy.hs +17/−41
- src/System/Process/Common.hs +159/−0
- src/System/Process/ListLike.hs +86/−0
- src/System/Process/Text.hs +14/−38
- src/System/Process/Text/Lazy.hs +16/−43
process-extras.cabal view
@@ -1,13 +1,13 @@ Name: process-extras-Version: 0.2.0+Version: 0.3.0 Synopsis: Process extras Description: Extra functionality for the Process library <http://hackage.haskell.org/package/process>.-Homepage: https://github.com/davidlazar/process-extras+Homepage: https://github.com/seereason/process-extras 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.6@@ -16,7 +16,7 @@ source-repository head Type: git- Location: https://github.com/davidlazar/process-extras+ Location: https://github.com/seereason/process-extras Library ghc-options: -Wall@@ -26,6 +26,8 @@ Exposed-modules: System.Process.ByteString System.Process.ByteString.Lazy+ System.Process.Common+ System.Process.ListLike System.Process.Text System.Process.Text.Lazy @@ -34,6 +36,7 @@ Build-depends: base >= 4 && < 5,+ ListLike >= 4, process, bytestring, text,
src/System/Process/ByteString.hs view
@@ -1,47 +1,25 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.ByteString where -import Control.Exception+import Control.Applicative ((<$>)) import Control.Monad import Data.ByteString (ByteString)-import qualified Data.ByteString as B+import Data.ListLike.IO (hGetContents)+import Data.Word (Word8)+import Prelude hiding (null) import System.Process+import System.Process.Common import System.Exit (ExitCode)-import System.IO-import Utils (forkWait) -- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'-readProcessWithExitCode- :: FilePath -- ^ command to run- -> [String] -- ^ any arguments- -> ByteString -- ^ standard input- -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr-readProcessWithExitCode cmd args input = mask $ \restore -> do- (Just inh, Just outh, Just errh, pid) <-- createProcess (proc cmd args){ std_in = CreatePipe,- std_out = CreatePipe,- std_err = CreatePipe }- flip onException- (do hClose inh; hClose outh; hClose errh;- terminateProcess pid; waitForProcess pid) $ restore $ do-- -- fork off a thread to start consuming stdout- waitOut <- forkWait $ B.hGetContents outh-- -- fork off a thread to start consuming stderr- waitErr <- forkWait $ B.hGetContents errh-- -- now write and flush any input- unless (B.null input) $ do B.hPutStr inh input; hFlush inh- hClose inh -- done with stdin-- -- wait on the output- out <- waitOut- err <- waitErr-- hClose outh- hClose errh+instance ListLikeProcessIO ByteString Word8 where+ forceOutput = return+ readChunks h = (: []) <$> hGetContents h - -- wait on the process- ex <- waitForProcess pid+-- | Specialized version for backwards compatibility.+readProcessWithExitCode :: FilePath -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)+readProcessWithExitCode = System.Process.Common.readProcessWithExitCode - return (ex, out, err)+readCreateProcessWithExitCode :: CreateProcess -> ByteString -> IO (ExitCode, ByteString, ByteString)+readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode
src/System/Process/ByteString/Lazy.hs view
@@ -1,50 +1,26 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.ByteString.Lazy where -import Control.Exception+import Control.Applicative ((<$>))+import Control.DeepSeq (force) import qualified Control.Exception as C (evaluate)-import Control.Monad-import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as B+import Data.ByteString.Lazy (ByteString, toChunks, fromChunks)+import Data.ListLike.IO (hGetContents)+import Data.Word (Word8)+import Prelude hiding (null) import System.Process+import System.Process.Common import System.Exit (ExitCode)-import System.IO-import Utils (forkWait) -- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'-readProcessWithExitCode- :: FilePath -- ^ command to run- -> [String] -- ^ any arguments- -> ByteString -- ^ standard input- -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr-readProcessWithExitCode cmd args input = mask $ \restore -> do- (Just inh, Just outh, Just errh, pid) <-- createProcess (proc cmd args){ std_in = CreatePipe,- std_out = CreatePipe,- std_err = CreatePipe }- flip onException- (do hClose inh; hClose outh; hClose errh;- terminateProcess pid; waitForProcess pid) $ restore $ do-- -- fork off a thread to start consuming stdout- out <- B.hGetContents outh- waitOut <- forkWait $ void $ C.evaluate $ B.length out-- -- fork off a thread to start consuming stderr- err <- B.hGetContents errh- waitErr <- forkWait $ void $ C.evaluate $ B.length err-- -- now write and flush any input- unless (B.null input) $ do B.hPutStr inh input; hFlush inh- hClose inh -- done with stdin-- -- wait on the output- waitOut- waitErr-- hClose outh- hClose errh+instance ListLikeProcessIO ByteString Word8 where+ forceOutput = C.evaluate . force+ readChunks h = (map (fromChunks . (: [])) . toChunks) <$> hGetContents h - -- wait on the process- ex <- waitForProcess pid+-- | Specialized version for backwards compatibility.+readProcessWithExitCode :: FilePath -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)+readProcessWithExitCode = System.Process.Common.readProcessWithExitCode - return (ex, out, err)+readCreateProcessWithExitCode :: CreateProcess -> ByteString -> IO (ExitCode, ByteString, ByteString)+readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode
+ src/System/Process/Common.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module System.Process.Common where++import Control.Applicative (pure, (<$>), (<*>))+import Control.Concurrent+import Control.Exception as E (SomeException, onException, catch, mask, throw)+import Control.Monad+import Data.ListLike (null)+import Data.ListLike.IO (ListLikeIO, hGetContents, hPutStr)+import Data.Monoid (Monoid(mempty, mappend), (<>))+import GHC.IO.Exception (IOErrorType(ResourceVanished), IOException(ioe_type))+import Prelude hiding (null)+import System.Exit (ExitCode(ExitFailure))+import System.IO (Handle, hClose, hFlush)+import System.IO.Unsafe (unsafeInterleaveIO)+import System.Process+import Utils (forkWait)++class Monoid b => ProcessOutput a b | b -> a where+ pidf :: ProcessHandle -> b+ outf :: a -> b+ errf :: a -> b+ intf :: SomeException -> b+ codef :: ExitCode -> b++instance ListLikeProcessIO 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++-- | 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 ListLikeIO a c => ListLikeProcessIO a c where+ forceOutput :: a -> IO a+ readChunks :: Handle -> IO [a]+ -- ^ Read from a handle, returning a lazy list of the monoid 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 -- ^ command and arguments to run+ -> a -- ^ standard input+ -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr+readCreateProcessWithExitCode = readCreateProcess++readCreateProcess :: (ProcessOutput a b, ListLikeProcessIO a c) => 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 }+ 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 $ outf <$> (hGetContents outh >>= forceOutput)++ -- fork off a thread to start consuming stderr+ waitErr <- forkWait $ errf <$> (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 <- codef <$> waitForProcess pid++ return $ out <> err <> ex++-- | Like readCreateProcess, but the output is read lazily.+readCreateProcessLazy :: (ProcessOutput a b, ListLikeProcessIO a c) => CreateProcess -> a -> IO b+readCreateProcessLazy p input = mask $ \restore -> do+ (Just inh, Just outh, Just errh, pid) <-+ createProcess p{ std_in = CreatePipe,+ std_out = CreatePipe,+ std_err = CreatePipe }+ onException+ (restore $+ do -- fork off a thread to start consuming stdout+ -- Without unsafeIntereleaveIO the pid messsage gets stuck+ -- until some additional output arrives from the process.+ waitOut <- forkWait $ (<>) <$> pure (pidf pid)+ <*> unsafeInterleaveIO (readInterleaved [(outf, outh), (errf, errh)] (codef <$> waitForProcess pid))+ writeInput inh input+ waitOut)+ (do terminateProcess pid; hClose inh; hClose outh; hClose errh;+ waitForProcess pid)++-- | Helper function for readCreateProcessLazy.+readInterleaved :: (ListLikeProcessIO a c, ProcessOutput a b) =>+ [(a -> b, Handle)] -> IO b -> IO b+readInterleaved pairs finish = newEmptyMVar >>= readInterleaved' pairs finish++readInterleaved' :: forall a b c. (ListLikeProcessIO 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)++-- | 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 :: ListLikeProcessIO 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.hs view
@@ -0,0 +1,86 @@+-- | 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.ListLike+ ( ListLikeProcessIO(forceOutput)+ , ProcessOutput(pidf, outf, errf, codef, intf)+ , readCreateProcess+ , readCreateProcessLazy+ , readCreateProcessWithExitCode+ , readProcessWithExitCode+ , Chunk(..)+ , collectOutput+ , showCreateProcessForUser+ , showCmdSpecForUser+ ) where++import Control.DeepSeq (force)+import Control.Exception as C (evaluate, SomeException, throw)+import Data.ListLike.IO (hGetContents)+import Data.Monoid (mempty, mconcat)+import Data.Text (unpack)+import Data.Text.Lazy (Text, toChunks)+import System.Exit (ExitCode)+import System.Process (CmdSpec(..), CreateProcess(..), ProcessHandle, showCommandForUser)+import System.Process.ByteString ()+import System.Process.ByteString.Lazy ()+import System.Process.Common (ListLikeProcessIO(forceOutput, readChunks), ProcessOutput(pidf, outf, errf, codef, intf),+ readCreateProcess, readCreateProcessLazy, 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 = evaluate . force+ -- | Read the handle as lazy text, convert to chunks of strict text,+ -- and then unpack into strings.+ readChunks h = do+ t <- hGetContents h :: IO Text+ return $ map unpack $ toChunks t++-- | This type is a concrete representation of the methods of class+-- ProcessOutput. If you take your process output as this type you+-- could, for example, echo all the output and then use collectOutput+-- below to convert it to any other instance of ProcessOutput.+data Chunk a+ = ProcessHandle ProcessHandle+ -- ^ This will always come first, before any output or exit code.+ | Stdout a+ | Stderr a+ | Result ExitCode+ | Exception SomeException+ -- ^ Note that the instances below do not use this constructor.++instance ListLikeProcessIO a c => ProcessOutput a [Chunk a] where+ pidf p = [ProcessHandle p]+ outf x = [Stdout x]+ errf x = [Stderr x]+ intf e = throw e+ codef c = [Result c]++instance ListLikeProcessIO 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 = throw e++-- | Turn a @[Chunk a]@ into any other instance of 'ProcessOutput'.+collectOutput :: ProcessOutput a b => [Chunk a] -> b+collectOutput xs = mconcat $ map (\ chunk -> case chunk of+ ProcessHandle x -> pidf x+ Stdout x -> outf x+ Stderr x -> errf x+ Result x -> codef x+ Exception x -> intf x) xs
src/System/Process/Text.hs view
@@ -1,48 +1,24 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Text where -import Control.Exception+import Control.Applicative ((<$>)) import Control.Monad+import Data.ListLike.IO (hGetContents) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T+import Prelude hiding (null) import System.Process+import System.Process.Common import System.Exit (ExitCode)-import System.IO-import Utils (forkWait) -- | Like 'System.Process.readProcessWithExitCode', but using 'Text'-readProcessWithExitCode- :: FilePath -- ^ command to run- -> [String] -- ^ any arguments- -> Text -- ^ standard input- -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr-readProcessWithExitCode cmd args input = mask $ \restore -> do- (Just inh, Just outh, Just errh, pid) <-- createProcess (proc cmd args){ std_in = CreatePipe,- std_out = CreatePipe,- std_err = CreatePipe }- flip onException- (do hClose inh; hClose outh; hClose errh;- terminateProcess pid; waitForProcess pid) $ restore $ do-- -- fork off a thread to start consuming stdout- waitOut <- forkWait $ T.hGetContents outh-- -- fork off a thread to start consuming stderr- waitErr <- forkWait $ T.hGetContents errh-- -- now write and flush any input- unless (T.null input) $ do T.hPutStr inh input; hFlush inh- hClose inh -- done with stdin-- -- wait on the output- out <- waitOut- err <- waitErr-- hClose outh- hClose errh+instance ListLikeProcessIO Text Char where+ forceOutput = return+ readChunks h = (: []) <$> hGetContents h - -- wait on the process- ex <- waitForProcess pid+-- | Specialized version for backwards compatibility.+readProcessWithExitCode :: FilePath -> [String] -> Text -> IO (ExitCode, Text, Text)+readProcessWithExitCode = System.Process.Common.readProcessWithExitCode - return (ex, out, err)+readCreateProcessWithExitCode :: CreateProcess -> Text -> IO (ExitCode, Text, Text)+readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode
src/System/Process/Text/Lazy.hs view
@@ -1,52 +1,25 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Text.Lazy where -import Control.DeepSeq (rnf)-import Control.Exception+import Control.Applicative ((<$>))+import Control.DeepSeq (force) import qualified Control.Exception as C (evaluate)-import Control.Monad-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T+import Data.ListLike.IO (hGetContents)+import Data.Text.Lazy (Text, fromChunks, toChunks)+import Prelude hiding (null) import System.Process+import System.Process.Common import System.Exit (ExitCode)-import System.IO-import Utils (forkWait) -- | Like 'System.Process.readProcessWithExitCode', but using 'Text'-readProcessWithExitCode- :: FilePath -- ^ command to run- -> [String] -- ^ any arguments- -> Text -- ^ standard input- -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr-readProcessWithExitCode cmd args input = mask $ \restore -> do- (Just inh, Just outh, Just errh, pid) <-- createProcess (proc cmd args){ std_in = CreatePipe,- std_out = CreatePipe,- std_err = CreatePipe }- flip onException- (do hClose inh; hClose outh; hClose errh;- terminateProcess pid; waitForProcess pid) $ restore $ do-- -- fork off a thread to start consuming stdout- out <- T.hGetContents outh- waitOut <- forkWait $ C.evaluate $ rnf out-- -- fork off a thread to start consuming stderr- err <- T.hGetContents errh- waitErr <- forkWait $ C.evaluate $ rnf err-- -- now write and flush any input- unless (T.null input) $ do T.hPutStr inh input; hFlush inh- hClose inh -- done with stdin-- -- wait on the output- waitOut- waitErr-- hClose outh- hClose errh+instance ListLikeProcessIO Text Char where+ forceOutput = C.evaluate . force+ readChunks h = (map (fromChunks . (: [])) . toChunks) <$> hGetContents h - -- wait on the process- ex <- waitForProcess pid+-- | Specialized version for backwards compatibility.+readProcessWithExitCode :: FilePath -> [String] -> Text -> IO (ExitCode, Text, Text)+readProcessWithExitCode = System.Process.Common.readProcessWithExitCode - return (ex, out, err)+readCreateProcessWithExitCode :: CreateProcess -> Text -> IO (ExitCode, Text, Text)+readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode