process-extras-0.4.1.4/0000755000000000000000000000000012716121213013022 5ustar0000000000000000process-extras-0.4.1.4/.ghci0000644000000000000000000000016412716121213013736 0ustar0000000000000000:set -isrc :set -DMIN_VERSION_deepseq(a,b,c)=1 :set -DMIN_VERSION_bytestring(a,b,c)=1 :load System.Process.ListLike process-extras-0.4.1.4/Setup.hs0000644000000000000000000000005612716121213014457 0ustar0000000000000000import Distribution.Simple main = defaultMain process-extras-0.4.1.4/LICENSE0000644000000000000000000000206512716121213014032 0ustar0000000000000000Copyright (c) 2012 David Lazar Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. process-extras-0.4.1.4/.travis.yml0000644000000000000000000000720712716121213015141 0ustar0000000000000000# This file has been generated -- see https://github.com/hvr/multi-ghc-travis language: c sudo: false cache: directories: - $HOME/.cabsnap - $HOME/.cabal/packages before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar matrix: include: - env: CABALVER=1.16 GHCVER=7.4.2 compiler: ": #GHC 7.4.2" addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2], sources: [hvr-ghc]}} - env: CABALVER=1.16 GHCVER=7.6.3 compiler: ": #GHC 7.6.3" addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}} - env: CABALVER=1.18 GHCVER=7.8.4 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - env: CABALVER=1.22 GHCVER=7.10.3 compiler: ": #GHC 7.10.3" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=8.0.1 compiler: ": #GHC 8.0.1" addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} - env: CABALVER=head GHCVER=head compiler: ": #GHC head" addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} allow_failures: - env: CABALVER=head GHCVER=head before_install: - unset CC - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH install: - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; fi - travis_retry cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then echo "cabal build-cache HIT"; rm -rfv .ghc; cp -a $HOME/.cabsnap/ghc $HOME/.ghc; cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; else echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; cabal install --only-dependencies --enable-tests --enable-benchmarks; fi # snapshot package-db on cache miss - if [ ! -d $HOME/.cabsnap ]; then echo "snapshotting package-db to build-cache"; mkdir $HOME/.cabsnap; cp -a $HOME/.ghc $HOME/.cabsnap/ghc; cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; fi # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - cabal test - cabal check - cabal sdist # tests that a source-distribution can be generated # Check that the resulting source distribution can be built & installed. # If there are no other `.tar.gz` files in `dist`, this can be even simpler: # `cabal install --force-reinstalls dist/*-*.tar.gz` - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && (cd dist && cabal install --force-reinstalls "$SRC_TGZ") # EOF process-extras-0.4.1.4/changelog0000644000000000000000000000123712716121213014677 0ustar0000000000000000haskell-process-extras (0.4.1.4) unstable; urgency=low * Add changelog and .ghci to Extra-Source-Files list. -- David Fox Sun, 15 May 2016 09:20:54 -0700 haskell-process-extras (0.4.1.3) unstable; urgency=low * Actually check changelog into git. -- David Fox Sun, 15 May 2016 09:00:03 -0700 haskell-process-extras (0.4) trusty-seereason; urgency=low * Add changelog * Wrap all the input processing with a catch resource vanished exception. * Add foldOutput and writeOutput, for handling Chunk streams. * Add some examples in README.md. -- David Fox Sun, 15 May 2016 08:59:47 -0700 process-extras-0.4.1.4/process-extras.cabal0000644000000000000000000000264212716121213016774 0ustar0000000000000000Name: process-extras Version: 0.4.1.4 Synopsis: Process extras Description: Extends . Read process input and output as ByteStrings or Text, or write your own ProcessOutput instance. Lazy process input and output. ProcessMaker class for more flexibility in the process creation API. Homepage: https://github.com/seereason/process-extras License: MIT License-file: LICENSE Author: David Lazar, Bas van Dijk, David Fox Maintainer: David Fox Category: System Build-type: Simple Cabal-version: >=1.6 Extra-source-files: README.md, .travis.yml, .ghci, changelog Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC >= 8 source-repository head Type: git Location: https://github.com/seereason/process-extras Library ghc-options: -Wall Hs-source-dirs: src Exposed-modules: System.Process.ByteString System.Process.ByteString.Lazy System.Process.Common System.Process.ListLike System.Process.Text System.Process.Text.Lazy Other-modules: Utils Build-depends: base >= 4.5 && < 5, ListLike >= 4, process, bytestring, text, deepseq >= 1.1, generic-deriving >= 1.10 process-extras-0.4.1.4/README.md0000644000000000000000000001024712716121213014305 0ustar0000000000000000# About 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 (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/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 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-0.4.1.4/src/0000755000000000000000000000000012716121213013611 5ustar0000000000000000process-extras-0.4.1.4/src/Utils.hs0000644000000000000000000000044012716121213015243 0ustar0000000000000000module Utils where import Control.Concurrent import Control.Exception forkWait :: IO a -> IO (IO a) forkWait a = do res <- newEmptyMVar _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return) process-extras-0.4.1.4/src/System/0000755000000000000000000000000012716121213015075 5ustar0000000000000000process-extras-0.4.1.4/src/System/Process/0000755000000000000000000000000012716121213016513 5ustar0000000000000000process-extras-0.4.1.4/src/System/Process/Common.hs0000644000000000000000000002020012716121213020271 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Common ( ProcessMaker(process) , ListLikeProcessIO(forceOutput, readChunks) , ProcessOutput(pidf, outf, errf, intf, codef) , readProcessWithExitCode , readCreateProcessWithExitCode , readCreateProcess , readCreateProcessLazy ) where import Control.Concurrent import Control.DeepSeq (NFData) import Control.Exception as E (SomeException, onException, catch, mask, throw, try) import Control.Monad import Data.ListLike as ListLike (null) import Data.ListLike.IO (ListLikeIO, hGetContents, hPutStr) import Data.Monoid ((<>)) import Generics.Deriving.Instances () import GHC.IO.Exception (IOErrorType(ResourceVanished), IOException(ioe_type)) import Prelude hiding (null) import System.Exit (ExitCode(..)) import System.IO (Handle, hClose, hFlush, BufferMode, hSetBuffering) import System.IO.Unsafe (unsafeInterleaveIO) import System.Process (CreateProcess(std_err, std_in, std_out), StdStream(CreatePipe), ProcessHandle, createProcess, proc, waitForProcess, terminateProcess) import Utils (forkWait) #if __GLASGOW_HASKELL__ <= 709 import Control.Applicative ((<$>), (<*>)) import Data.Monoid (Monoid(mempty, mappend)) #endif #if !MIN_VERSION_deepseq(1,4,2) -- | This instance lets us use DeepSeq's force function on a stream of Chunks. instance NFData ExitCode #endif class ProcessMaker a where process :: a -> IO (Handle, Handle, Handle, ProcessHandle) -- | This is the usual maker argument to 'readCreateProcess'. instance ProcessMaker CreateProcess where process p = do (Just inh, Just outh, Just errh, pid) <- createProcess p { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe } return (inh, outh, errh, pid) -- | Passing this to 'readCreateProcess' as the maker argument allows -- you to set the buffer mode of the process stdout and stderr handles -- just after the handles are created. These are set to -- BlockBuffering by default, but for running console commands -- LineBuffering is probably what you want. instance ProcessMaker (CreateProcess, BufferMode, BufferMode) where process (p, outmode, errmode) = do (Just inh, Just outh, Just errh, pid) <- createProcess p { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe } hSetBuffering outh outmode hSetBuffering errh errmode return (inh, outh, errh, pid) 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 :: (ProcessMaker maker, ListLikeProcessIO a c) => maker -- ^ command and arguments to run -> a -- ^ standard input -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = readCreateProcess 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 (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. writeInput inh input -- 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 :: (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 (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 $ (<>) <$> return (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 `E.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 = 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. ignoreResourceVanished :: IO () -> IO () ignoreResourceVanished action = action `E.catch` (\e -> if ioe_type e == ResourceVanished then return () else ioError e) process-extras-0.4.1.4/src/System/Process/ByteString.hs0000644000000000000000000000271012716121213021141 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.ByteString where #if __GLASGOW_HASKELL__ <= 709 import Control.Applicative ((<$>)) #endif import Control.Monad import Data.ByteString (ByteString) import Data.ListLike.IO (hGetContents) import Data.Word (Word8) import Prelude hiding (null) import System.Process import System.Process.Common import System.Exit (ExitCode) #if !MIN_VERSION_bytestring(0,10,0) import Control.DeepSeq (NFData) instance NFData ByteString #endif -- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString' instance ListLikeProcessIO ByteString Word8 where forceOutput = return readChunks h = (: []) <$> hGetContents h -- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -- ^ command to run -> [String] -- ^ any arguments -> ByteString -- ^ standard input -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr readProcessWithExitCode = System.Process.Common.readProcessWithExitCode readCreateProcessWithExitCode :: CreateProcess -- ^ command and arguments to run -> ByteString -- ^ standard input -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode process-extras-0.4.1.4/src/System/Process/Text.hs0000644000000000000000000000225112716121213017773 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Text where import Control.Applicative ((<$>)) import Control.Monad import Data.ListLike.IO (hGetContents) import Data.Text (Text) import Prelude hiding (null) import System.Process import System.Process.Common import System.Exit (ExitCode) -- | Like 'System.Process.readProcessWithExitCode', but using 'Text' instance ListLikeProcessIO Text Char where forceOutput = return readChunks h = (: []) <$> hGetContents h -- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -- ^ command to run -> [String] -- ^ any arguments -> Text -- ^ standard input -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr readProcessWithExitCode = System.Process.Common.readProcessWithExitCode readCreateProcessWithExitCode :: CreateProcess -- ^ command and arguments to run -> Text -- ^ standard input -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode process-extras-0.4.1.4/src/System/Process/ListLike.hs0000644000000000000000000001121212716121213020564 0ustar0000000000000000-- | Re-export all symbols and instances of the process-extras -- package. Adds the Chunk type with a ProcessOutput instance, and a -- collectOutput function to turn a list of chunks into any instance -- of ProcessOutput, such as (ExitCode, String, String). This means -- you can have readCreateProcess output a list of Chunk, operate on -- it to do progress reporting, and finally convert it to the type -- that readProcessWithExitCode woud have returned. {-# LANGUAGE CPP, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, UndecidableInstances #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module System.Process.ListLike ( ProcessMaker(process) , ListLikeProcessIO(forceOutput) , ProcessOutput(pidf, outf, errf, codef, intf) , readCreateProcess , readCreateProcessLazy , readCreateProcessWithExitCode , 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, 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.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), 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. deriving Show instance Show ProcessHandle where show _ = "" 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 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 (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 [] = return () writeOutput (x : xs) = foldOutput (\_ -> return ()) (hPutStr stdout) (hPutStr stderr) (\_ -> return ()) (\_ -> return ()) x >> writeOutput xs process-extras-0.4.1.4/src/System/Process/Text/0000755000000000000000000000000012716121213017437 5ustar0000000000000000process-extras-0.4.1.4/src/System/Process/Text/Lazy.hs0000644000000000000000000000246212716121213020716 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Text.Lazy where import Control.Applicative ((<$>)) import Control.DeepSeq (force) import qualified Control.Exception as C (evaluate) 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) -- | Like 'System.Process.readProcessWithExitCode', but using 'Text' instance ListLikeProcessIO Text Char where forceOutput = C.evaluate . force readChunks h = (map (fromChunks . (: [])) . toChunks) <$> hGetContents h -- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -- ^ command to run -> [String] -- ^ any arguments -> Text -- ^ standard input -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr readProcessWithExitCode = System.Process.Common.readProcessWithExitCode readCreateProcessWithExitCode :: CreateProcess -- ^ command and arguments to run -> Text -- ^ standard input -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode process-extras-0.4.1.4/src/System/Process/ByteString/0000755000000000000000000000000012716121213020605 5ustar0000000000000000process-extras-0.4.1.4/src/System/Process/ByteString/Lazy.hs0000644000000000000000000000312112716121213022055 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.ByteString.Lazy where #if __GLASGOW_HASKELL__ <= 709 import Control.Applicative ((<$>)) #endif import Control.DeepSeq (force) import qualified Control.Exception as C (evaluate) 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) #if !MIN_VERSION_bytestring(0,10,0) import Control.DeepSeq (NFData) instance NFData ByteString #endif -- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString' instance ListLikeProcessIO ByteString Word8 where forceOutput = C.evaluate . force readChunks h = (map (fromChunks . (: [])) . toChunks) <$> hGetContents h -- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -- ^ command to run -> [String] -- ^ any arguments -> ByteString -- ^ standard input -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr readProcessWithExitCode = System.Process.Common.readProcessWithExitCode readCreateProcessWithExitCode :: CreateProcess -- ^ command and arguments to run -> ByteString -- ^ standard input -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode