process-extras 0.3.4 → 0.4
raw patch · 4 files changed
+118/−50 lines, 4 filesdep ~basedep ~deepseq
Dependency ranges changed: base, deepseq
Files
- README.md +56/−2
- process-extras.cabal +1/−1
- src/System/Process/Common.hs +26/−39
- src/System/Process/ListLike.hs +35/−8
README.md view
@@ -3,11 +3,65 @@ Extra functionality for the [Process library](http://hackage.haskell.org/package/process). * Read process input and output as ByteStrings or Text, or write your own ProcessOutput instance.- * Lazy process input and output.+ * Lazy process input and output (i.e. read output from processes that run forever.) * ProcessMaker class for more flexibility in the process creation API. # Contributing This project is available on [GitHub](https://github.com/seereason/process-extras). You may contribute changes there. -Please report bugs and feature requests using the [GitHub issue tracker](https://github.com/ddssff/process-extras/issues).+Please report bugs and feature requests using the [GitHub issue tracker](https://github.com/seereason/process-extras/issues).++# Examples:++The output type of the raw system process functions is ByteString.+Instances of ListLikeProcessIO are provided to read as type String,+Text, Lazy Text, ByteString, or Lazy ByteString. Select by casting+the result, or by specifying the module containing the specialized+function:++ > :m +System.Process.ListLike Data.ByteString Data.Text.Lazy+ > readCreateProcessWithExitCode (shell "echo 'λ'") mempty :: IO (ExitCode, ByteString, ByteString)+ (ExitSuccess,"\206\187\n","")+ > readCreateProcessWithExitCode (shell "echo 'λ'") mempty :: IO (ExitCode, Text, Text)+ (ExitSuccess,"\955\n","")+ > readCreateProcessWithExitCode (shell "echo 'λ'") mempty :: IO (ExitCode, String, String)+ (ExitSuccess,"\955\n","")+ > System.Process.Text.readCreateProcessWithExitCode (shell "yes | head -10") mempty+ (ExitSuccess,"y\ny\ny\ny\ny\ny\ny\ny\ny\ny\n","")++Although the output *type* can be lazy, normal process functions still+need to read until EOF on the process output before returing anything.+If you have a process whose output never ends you can use the+readCreateProcessLazy function to read it. Functions like readProcess+would block waiting for EOF on the process output:++ > (Prelude.take 4 <$> readCreateProcessLazy (proc "yes" []) mempty :: IO [Chunk Text]) >>= mapM_ (putStrLn . show)+ ProcessHandle <process>+ Stdout "y\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny\ny ..."+ ...++The output type can be any instance of ProcessOutput, instances for+types (ExitCode, a, a), [Chunk a], and (ExitCode, [Chunk a]) are+provided. [Chunk a] can be converted to any other instance of+ProcessOutput using collectOutput++ > (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO [Chunk ByteString]) >>= mapM_ (putStrLn . show)+ Stdout "\US\139\b\NUL\237\136\&7W\NUL\ETX345\183\&403\215\&31Q04267\177\&0\177\212\&33\225\STX\NUL_\169\142\178\ETB\NUL\NUL\NUL"+ Stderr "gzip: stdin: file size changed while zipping\n -8.7%\n"+ Result ExitSuccess+ > (readCreateProcess (shell "uptime") mempty :: IO [Chunk ByteString]) >>= writeOutput+ 14:00:34 up 18 days, 7:16, 6 users, load average: 0.04, 0.10, 0.08+ > collectOutput <$> (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO [Chunk ByteString]) :: IO (ExitCode, ByteString, ByteString)+ (ExitSuccess,"\US\139\b\NUL\185\137\&7W\NUL\ETX345\183\&427\212\&33W0426731\177\208\&35\225\STX\NUL\237\192\CAN\224\ETB\NUL\NUL\NUL","gzip: stdin: file size changed while zipping\n -8.7%\n")+ > collectOutput <$> (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO [Chunk ByteString]) :: IO (ExitCode, ByteString, ByteString)+ (ExitSuccess,"\US\139\b\NUL\185\137\&7W\NUL\ETX345\183\&427\212\&33W0426731\177\208\&35\225\STX\NUL\237\192\CAN\224\ETB\NUL\NUL\NUL","gzip: stdin: file size changed while zipping\n -8.7%\n")+ > (collectOutput . filter (\x -> case x of Stderr _ -> False; _ -> True)) <$> (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO [Chunk ByteString]) :: IO (ExitCode, ByteString, ByteString)+ (ExitSuccess,"\US\139\b\NUL<\138\&7W\NUL\ETX345\183\&410\210\&3\176P04267713\213\&37\224\STX\NULT\142\EOT\165\ETB\NUL\NUL\NUL","")++Some cases that need investigation:++ > (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO [Chunk String]) >>= mapM_ (putStrLn . show)+ *** Exception: fd:13: hGetContents: invalid argument (invalid byte sequence)+ > (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO [Chunk Text]) >>= mapM_ (putStrLn . show)+ *** Exception: fd:13: hClose: invalid argument (Bad file descriptor)
process-extras.cabal view
@@ -1,5 +1,5 @@ Name: process-extras-Version: 0.3.4+Version: 0.4 Synopsis: Process extras Description: Extends <http://hackage.haskell.org/package/process>. Read process input and output as ByteStrings or
src/System/Process/Common.hs view
@@ -1,17 +1,15 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Common ( ProcessMaker(process) , ListLikeProcessIO(forceOutput, readChunks)- , ProcessOutput(ProcessInput, pidf, outf, errf, intf, codef)+ , ProcessOutput(pidf, outf, errf, intf, codef) , readProcessWithExitCode , readCreateProcessWithExitCode , readCreateProcess@@ -65,16 +63,14 @@ hSetBuffering errh errmode return (inh, outh, errh, pid) -class Monoid (ProcessInput a) => ProcessOutput a where- type ProcessInput a- pidf :: ProcessHandle -> a- outf :: ProcessInput a -> a- errf :: ProcessInput a -> a- intf :: SomeException -> a- codef :: ExitCode -> a+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 (ExitCode, a, a) where- type ProcessInput (ExitCode, a, a) = a+instance ListLikeProcessIO a c => ProcessOutput a (ExitCode, a, a) where pidf _ = mempty codef c = (c, mempty, mempty) outf x = (mempty, x, mempty)@@ -109,7 +105,7 @@ -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = readCreateProcess -readCreateProcess :: (ProcessMaker maker, ProcessOutput b, ListLikeProcessIO (ProcessInput b) c) => maker -> ProcessInput b -> IO b+readCreateProcess :: (ProcessMaker maker, ProcessOutput a b, ListLikeProcessIO a c) => maker -> a -> IO b readCreateProcess maker input = mask $ \restore -> do (inh, outh, errh, pid) <- process maker flip onException@@ -122,14 +118,8 @@ -- fork off a thread to start consuming stderr waitErr <- forkWait $ errf <$> (hGetContents errh >>= forceOutput) - -- now write and flush any input. Catch and ignore- -- ResourceVanished to avoid crashes when the process we are- -- writing to exits prematurely.- ignoreResourceVanished $ do- unless (ListLike.null input) $ do- hPutStr inh input- hFlush inh- hClose inh -- stdin has been fully written+ -- now write and flush any input.+ writeInput inh input -- wait on the output out <- waitOut@@ -143,15 +133,8 @@ return $ out <> err <> ex -ignoreResourceVanished :: IO () -> IO ()-ignoreResourceVanished action =- try action >>= either ignoreResourceVanished' return- where- ignoreResourceVanished' e | ioe_type e == ResourceVanished = return ()- ignoreResourceVanished' e = throw e- -- | Like readCreateProcess, but the output is read lazily.-readCreateProcessLazy :: (ProcessMaker maker, ProcessOutput b, ListLikeProcessIO (ProcessInput b) c) => maker -> ProcessInput b -> IO b+readCreateProcessLazy :: (ProcessMaker maker, ProcessOutput a b, ListLikeProcessIO a c) => maker -> a -> IO b readCreateProcessLazy maker input = mask $ \restore -> do (inh, outh, errh, pid) <- process maker onException@@ -167,19 +150,19 @@ waitForProcess pid) -- | Helper function for readCreateProcessLazy.-readInterleaved :: (ListLikeProcessIO (ProcessInput b) c, ProcessOutput b) =>- [(ProcessInput b -> b, Handle)] -> IO b -> IO b+readInterleaved :: (ListLikeProcessIO a c, ProcessOutput a b) =>+ [(a -> b, Handle)] -> IO b -> IO b readInterleaved pairs finish = newEmptyMVar >>= readInterleaved' pairs finish -readInterleaved' :: forall b c. (ListLikeProcessIO (ProcessInput b) c, ProcessOutput b) =>- [(ProcessInput b -> b, Handle)] -> IO b -> MVar (Either Handle b) -> IO b+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 :: (ProcessInput b -> b) -> Handle -> IO ()+ readHandle :: (a -> b) -> Handle -> IO () readHandle f h = do cs <- readChunks h -- If the type returned as stdout and stderr is lazy we need@@ -203,13 +186,17 @@ -- 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 ())+writeInput inh input =+ ignoreResourceVanished $ do+ unless (ListLike.null input) $ do+ hPutStr inh input+ hFlush inh+ hClose inh -- stdin has been fully written -- | 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+ignoreResourceVanished :: IO () -> IO ()+ignoreResourceVanished action =+ action `catch` (\e -> if ioe_type e == ResourceVanished then pure () else ioError e)
src/System/Process/ListLike.hs view
@@ -17,20 +17,25 @@ , readProcessWithExitCode , Chunk(..) , collectOutput+ , foldOutput+ , writeOutput , showCreateProcessForUser , showCmdSpecForUser+ , proc+ , shell ) where import Control.DeepSeq (force) import Control.Exception as C (evaluate, SomeException, throw)-import Data.ListLike.IO (hGetContents)+import Data.ListLike.IO (hGetContents, hPutStr, ListLikeIO) #if __GLASGOW_HASKELL__ <= 709 import Data.Monoid (mempty, mconcat) #endif import Data.Text (unpack) import Data.Text.Lazy (Text, toChunks) import System.Exit (ExitCode)-import System.Process (CmdSpec(..), CreateProcess(..), ProcessHandle, showCommandForUser)+import System.IO (stdout, stderr)+import System.Process (CmdSpec(..), CreateProcess(..), proc, ProcessHandle, shell, showCommandForUser) import System.Process.ByteString () import System.Process.ByteString.Lazy () import System.Process.Common (ProcessMaker(process), ListLikeProcessIO(forceOutput, readChunks), ProcessOutput(pidf, outf, errf, codef, intf),@@ -70,7 +75,11 @@ | Result ExitCode | Exception SomeException -- ^ Note that the instances below do not use this constructor.+ deriving Show +instance Show ProcessHandle where+ show _ = "<process>"+ instance ListLikeProcessIO a c => ProcessOutput a [Chunk a] where pidf p = [ProcessHandle p] outf x = [Stdout x]@@ -85,11 +94,29 @@ errf x = (mempty, [Stderr x]) intf e = throw e +foldOutput :: (ProcessHandle -> r)+ -> (a -> r)+ -> (a -> r)+ -> (SomeException -> r)+ -> (ExitCode -> r)+ -> Chunk a+ -> r+foldOutput p _ _ _ _ (ProcessHandle x) = p x+foldOutput _ o _ _ _ (Stdout x) = o x+foldOutput _ _ e _ _ (Stderr x) = e x+foldOutput _ _ _ i _ (Exception x) = i x+foldOutput _ _ _ _ r (Result x) = r x+ -- | 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+collectOutput xs = mconcat $ map (foldOutput pidf outf errf intf codef) xs++-- | Send Stdout chunks to stdout and Stderr chunks to stderr.+writeOutput :: ListLikeIO a c => [Chunk a] -> IO ()+writeOutput [] = pure ()+writeOutput (x : xs) =+ foldOutput (\_ -> pure ())+ (hPutStr stdout)+ (hPutStr stderr)+ (\_ -> pure ())+ (\_ -> pure ()) x >> writeOutput xs