process-extras-0.7.4/0000755000000000000000000000000013235364332012676 5ustar0000000000000000process-extras-0.7.4/.ghci0000644000000000000000000000023413235364332013610 0ustar0000000000000000:set -isrc :set -XFlexibleContexts :set -DMIN_VERSION_deepseq(a,b,c)=1 :set -DMIN_VERSION_bytestring(a,b,c)=1 :set -DMIN_VERSION_base(a,b,c)=1 :load Tests process-extras-0.7.4/Setup.hs0000644000000000000000000000005613235364332014333 0ustar0000000000000000import Distribution.Simple main = defaultMain process-extras-0.7.4/Tests.hs0000644000000000000000000000520113235364332014332 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleInstances #-} #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import System.Exit (ExitCode(..), exitWith) import System.Process.Run (Chunk(ProcessHandle, Result, Stdout, Stderr), CreateProcess, collectOutput, dots, echoStart, echoEnd, indent, lazy, output, proc, run, runT, shell, silent, vlevel) import System.Process.ByteString () import System.Process.ByteString.Lazy () import System.Process.Text () import System.Process.Text.Lazy () import Test.HUnit main :: IO () main = runTestTT (TestList [test0]) >>= \cts -> exitWith $ if errors cts + failures cts > 0 then ExitFailure 1 else ExitSuccess instance Eq (Chunk String) where (Stdout a) == (Stdout b) = a == b (Stderr a) == (Stderr b) = a == b (Result a) == (Result b) = a == b _ == _ = False -- Every fourth run these will say: -- *System.Process.Run> _test4 -- -> ls -- : fd:12: hGetBuffering: illegal operation (handle is closed) -- : fd:14: hGetBuffering: illegal operation (handle is closed) -- *** Exception: thread blocked indefinitely in an MVar operation -- Oldest file in /usr/share/doc file :: FilePath file = "/usr/share/doc/cron/THANKS" dir :: FilePath dir = "/usr/share/doc/cron" cmd :: CreateProcess cmd = shell "echo a; echo b 1>&2; printf c" omitProcessHandle :: [Chunk a] -> [Chunk a] omitProcessHandle [] = [] omitProcessHandle (ProcessHandle _ : more) = omitProcessHandle more omitProcessHandle (x : xs) = x : omitProcessHandle xs test0 :: Test test0 = TestCase $ do let expected = (ExitSuccess, "a\nc", "b\n") :: (ExitCode, String, String) actual <- collectOutput <$> runT (output >> run cmd "") assertEqual "test1" expected actual -- | What we want to test with these is what gets written to the console, -- and I haven't yet invested the thought required to do that. Divert the -- console output somehow I guess... _test1 :: IO [Chunk String] _test1 = runT (output >> run (proc "ls" []) "") _test2 :: IO [Chunk String] _test2 = runT (vlevel 0 >> run (proc "ls" []) "") _test2a :: IO (ExitCode, String, String) _test2a = runT (silent >> run (proc "ls" []) "") _test3 :: IO [Chunk String] _test3 = runT (dots 10 >> run (proc "ls" []) "") _test4 :: IO [Chunk String] _test4 = runT (lazy >> indent (const "1> ") (const "2> ") >> run (proc "ls" []) "") _test5 :: IO [Chunk String] _test5 = runT (echoStart >> echoEnd >> run (proc "ls" []) "") _test6 :: IO [Chunk String] _test6 = (runT (silent >> echoStart >> echoEnd >> run (proc "yes" []) "") :: IO [Chunk String]) >>= return . take 2 process-extras-0.7.4/LICENSE0000644000000000000000000000206513235364332013706 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.7.4/.travis.yml0000644000000000000000000000675613235364332015025 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.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.7.4/changelog0000644000000000000000000000252713235364332014556 0ustar0000000000000000haskell-process-extras (0.7.1) unstable; urgency=low * Add System.Process.Run, utilities and a monad for process progress output. * Rename ProcessOutput -> ProcessResult * Add a ProcessText class to characterize the type written to standard input and read from standard output and error. * Add an alias for readCreateProcess named readCreateProcessStrict * Update README.md -- David Fox Mon, 05 Dec 2016 10:52:20 -0800 haskell-process-extras (0.5) unstable; urgency=low * Have writeOutput return the input list rather than () * Additional re-exports from the process package -- David Fox Mon, 21 Nov 2016 12:45:57 -0800 haskell-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.7.4/process-extras.cabal0000644000000000000000000000333713235364332016652 0ustar0000000000000000Name: process-extras Version: 0.7.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.10 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 Default-Language: Haskell2010 ghc-options: -Wall Hs-source-dirs: src Exposed-modules: System.Process.ByteString System.Process.ByteString.Lazy System.Process.Chars System.Process.Common System.Process.ListLike System.Process.Run System.Process.Text System.Process.Text.Lazy System.Process.Text.Builder Other-modules: Utils Build-depends: base >= 4.5 && < 5, data-default, ListLike >= 4.4, mtl, process, bytestring, text, deepseq >= 1.1, generic-deriving >= 1.10 Test-Suite process-extras-tests Default-Language: Haskell2010 type: exitcode-stdio-1.0 Hs-Source-Dirs: . Main-Is: Tests.hs Build-Depends: base, HUnit, process-extras process-extras-0.7.4/README.md0000644000000000000000000001047113235364332014160 0ustar0000000000000000# What is process-extras You might want to use this package if * You want to read and write ByteStrings or Text to a process rather than just Strings * You want to read output from a non-terminating process (e.g. yes(1)) * You want more flexibility in process creation * You want various types of progress output from the process to the console before capturing its output - indented and prefixed output, reporting of the command that started the process, dots to reflect the size of the process output, etc. # 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 > readCreateProcess (shell "echo 'λ'") mempty :: IO (ExitCode, ByteString, ByteString) (ExitSuccess,"\206\187\n","") > readCreateProcess (shell "echo 'λ'") mempty :: IO (ExitCode, Text, Text) (ExitSuccess,"\955\n","") > readCreateProcess (shell "echo 'λ'") mempty :: IO (ExitCode, String, String) (ExitSuccess,"\955\n","") > readCreateProcess (shell "yes | head -10") mempty :: IO (ExitCode, Text, Text) (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_ (Prelude.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 . Prelude.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.7.4/src/0000755000000000000000000000000013235364332013465 5ustar0000000000000000process-extras-0.7.4/src/Utils.hs0000644000000000000000000000044013235364332015117 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.7.4/src/System/0000755000000000000000000000000013235364332014751 5ustar0000000000000000process-extras-0.7.4/src/System/Process/0000755000000000000000000000000013235364332016367 5ustar0000000000000000process-extras-0.7.4/src/System/Process/Common.hs0000644000000000000000000002320013235364332020150 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, showProcessMakerForUser) , ListLikeProcessIO(forceOutput, readChunks) , ProcessText , ProcessResult(pidf, outf, errf, intf, codef) , readProcessWithExitCode , readCreateProcessWithExitCode , readCreateProcessStrict , readCreateProcessLazy , showCmdSpecForUser , showCreateProcessForUser ) where import Control.Concurrent import Control.Exception as E (SomeException, onException, catch, mask, throw) import Control.Monad import Data.ListLike as ListLike (ListLike, null) import Data.ListLike.IO (ListLikeIO, hGetContents, hPutStr) import Data.Monoid ((<>)) import Data.String (IsString) 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 (CmdSpec(..), CreateProcess(cmdspec, cwd, std_err, std_in, std_out), StdStream(CreatePipe), ProcessHandle, createProcess, proc, showCommandForUser, 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) import Control.DeepSeq (NFData) -- | 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) showProcessMakerForUser :: a -> String -- | This is the usual maker argument to 'readCreateProcessLazy'. 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) showProcessMakerForUser = showCreateProcessForUser -- | Passing this to 'readCreateProcessLazy' 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) showProcessMakerForUser (p, outmode, errmode) = showCreateProcessForUser p ++ " outmode=" ++ show outmode ++ ", errmode=" ++ show errmode class (IsString text, Monoid text, ListLike text char) => ProcessText text char class Monoid result => ProcessResult text result | result -> text where pidf :: ProcessHandle -> result outf :: text -> result errf :: text -> result intf :: SomeException -> result codef :: ExitCode -> result instance ListLikeProcessIO text char => ProcessResult text (ExitCode, text, text) 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 #if MIN_VERSION_base(4,11,0) instance Semigroup ExitCode where (<>) = mappend #endif -- | Process IO is based on the 'ListLikeIO' class from the ListLike -- package class ListLikeIO text char => ListLikeProcessIO text char where forceOutput :: text -> IO text readChunks :: Handle -> IO [text] -- ^ Read from a handle, returning a lazy list of the monoid a. -- | Like 'System.Process.readProcessWithExitCode', but with -- generalized input and output type. Aside from the usual text-like -- types, the output can be a list of Chunk a. This lets you process -- the chunks received from stdout and stderr lazil, in the order they -- are received, as well as the exit code. Utilities to handle Chunks -- are provided in System.Process.ListLike. readProcessWithExitCode :: ListLikeProcessIO text char => FilePath -- ^ command to run -> [String] -- ^ any arguments -> text -- ^ standard input -> IO (ExitCode, text, text) -- ^ exitcode, stdout, stderr readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc cmd args) input readCreateProcessWithExitCode :: (ProcessMaker maker, ListLikeProcessIO text char) => maker -- ^ command and arguments to run -> text -- ^ standard input -> IO (ExitCode, text, text) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = readCreateProcessStrict readCreateProcessStrict :: (ProcessMaker maker, ProcessResult text result, ListLikeProcessIO text char) => maker -> text -> IO result readCreateProcessStrict 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 readCreateProcessStrict, but the output is read lazily. readCreateProcessLazy :: (ProcessMaker maker, ProcessResult 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, ProcessResult a b) => [(a -> b, Handle)] -> IO b -> IO b readInterleaved pairs finish = newEmptyMVar >>= readInterleaved' pairs finish readInterleaved' :: forall a b c. (ListLikeProcessIO a c, ProcessResult 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) -- | 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 process-extras-0.7.4/src/System/Process/Run.hs0000644000000000000000000002706613235364332017502 0ustar0000000000000000-- | Flexible control of progress reporting for readCreateProcess and friends. {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} module System.Process.Run ( -- * Monad transformer RunT , runT , RunState(..) , OutputStyle(..) -- * Monad class , RunM -- * Modify moand RunM state parameters , echoStart , echoEnd , output , silent , dots , indent , vlevel , quieter , noisier , lazy , strict , message -- * Monadic process runner , run -- * Re-exports , module System.Process.ListLike ) where #if __GLASGOW_HASKELL__ <= 709 import Data.Monoid (Monoid, mempty) #endif import Control.Monad (when) import Control.Monad.State (evalState, evalStateT, get, modify, MonadState, put, StateT) import Control.Monad.Trans (MonadIO, lift, liftIO) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as Lazy (ByteString) import Data.Char (ord) import Data.Default (Default(def)) import Data.ListLike as ListLike (break, fromList, head, hPutStr, length, ListLike, null, putStr, singleton, tail) import Data.Monoid ((<>)) import Data.String (IsString, fromString) import Data.Text (Text) import Data.Word (Word8) import qualified Data.Text.Lazy as Lazy (Text) import System.IO (hPutStr, hPutStrLn, stderr) import System.Process.ListLike -- | This is the state record that controls the output style. data RunState text = RunState { _output :: OutputStyle -- ^ Overall style of output , _outprefix :: text -- ^ Prefix for lines of stdout , _errprefix :: text -- ^ Prefix for lines of stderr , _echoStart :: Bool -- ^ Echo command as process starts , _echoEnd :: Bool -- ^ Echo command as process finishes , _verbosity :: Int -- ^ A progression of progress modes , _lazy :: Bool -- ^ Use the lazy or strict runner? , _message :: text -- ^ Extra text for start/end message - e.g. the change root } type RunT text m = StateT (RunState text) m class (MonadState (RunState text) m, ProcessText text char, ListLikeProcessIO text char, MonadIO m, IsString text, Eq char, Dot char) => RunM text char m instance Dot Word8 where dot = fromIntegral (ord '.') instance (MonadIO m, MonadState (RunState String) m) => RunM String Char m instance (MonadIO m, MonadState (RunState Text) m) => RunM Text Char m instance (MonadIO m, MonadState (RunState Lazy.Text) m) => RunM Lazy.Text Char m instance (MonadIO m, MonadState (RunState ByteString) m) => RunM ByteString Word8 m instance (MonadIO m, MonadState (RunState Lazy.ByteString) m) => RunM Lazy.ByteString Word8 m runT :: forall m text char a. (MonadIO m, ProcessText text char) => RunT text m a -> m a runT action = evalStateT action (def :: RunState text) data OutputStyle = Dots Int -- ^ Output one dot per n output characters | All -- ^ send process stdout to console stdout and process stderr to console stderr | Indented -- ^ Output with prefixes | Silent -- ^ No output instance ProcessText text char => Default (RunState text) where def = RunState { _outprefix = fromString "1> " , _errprefix = fromString "2> " , _output = All , _echoStart = True , _echoEnd = True , _verbosity = 3 , _lazy = False , _message = mempty } {- class (Monoid text, MonadIO m) => MonadRun m text where type Text m getRunState :: m (RunState text) putRunState :: RunState text -> m () instance Monoid text => MonadRun IO text where getRunState = return def putRunState _ = return () instance (MonadIO m, Monoid t, MonadState (RunState t) m) => MonadRun m t where getRunState = get putRunState = put -} noEcho :: (MonadState (RunState t) m) => m () noEcho = modify (\x -> x { _echoStart = False, _echoEnd = False }) echoStart :: (MonadState (RunState t) m) => m () echoStart = modify (\x -> x { _echoStart = True }) echoEnd :: (MonadState (RunState t) m) => m () echoEnd = modify (\x -> x { _echoEnd = True }) output :: (MonadState (RunState t) m) => m () output = modify (\x -> x { _output = All }) silent :: (MonadState (RunState t) m) => m () silent = modify (\x -> x { _output = Silent }) dots :: (MonadState (RunState t) m) => Int -> m () dots n = modify (\x -> x { _output = Dots n }) -- | Modify the indentation prefixes for stdout and stderr in the -- progress monad. indent :: (MonadState (RunState t) m, ListLike t char) => (t -> t) -> (t -> t) -> m () indent so se = modify $ \x -> let so' = so (_outprefix x) se' = se (_errprefix x) in x { _outprefix = so' , _errprefix = se' , _output = if ListLike.null so' && ListLike.null se' then _output x else Indented } noIndent :: (MonadState (RunState text) m, ListLike text char) => m () noIndent = indent (const mempty) (const mempty) -- | Set verbosity to a specific level from 0 to 3. -- vlevel :: (MonadIO m, Monoid text, MonadState (RunState text) m) => Int -> m () -- vlevel :: forall m text char. (IsString text, ListLike text char, MonadIO m) => Int -> m () vlevel :: forall m text char. (IsString text, ListLike text char, MonadIO m, MonadState (RunState text) m) => Int -> m () vlevel n = do modify (\x -> x {_verbosity = n}) case n of _ | n <= 0 -> noEcho >> silent >> noIndent -- No output 1 -> vlevel 0 >> echoStart -- Output command at start 2 -> vlevel 1 >> echoEnd >> dots 100 -- Output command at start and end, dots to show output _ -> -- echo command at start and end, and send all output -- to the console with channel prefixes 1> and 2> vlevel 2 >> output >> indent (const (fromString "1> ")) (const (fromString ("2> "))) quieter :: RunM text char m => m () quieter = get >>= \x -> vlevel (_verbosity x - 1) noisier :: RunM text char m => m () noisier = get >>= \x -> vlevel (_verbosity x + 1) strict :: RunM text char m => m () strict = modify (\x -> x { _lazy = False }) lazy :: RunM text char m => m () lazy = modify (\x -> x { _lazy = True}) message :: RunM text char m => (text -> text) -> m () message f = modify (\x -> x { _message = f (_message x) }) class Dot c where dot :: c instance Dot Char where dot = '.' run' :: forall m maker text char. (RunM text char m, ProcessMaker maker) => maker -> text -> m [Chunk text] run' maker input = do st0 <- get when (_echoStart st0) (liftIO $ hPutStrLn stderr ("-> " ++ showProcessMakerForUser maker)) result <- liftIO $ (if _lazy st0 then readCreateProcessLazy else readCreateProcess) maker input >>= doOutput st0 when (_echoEnd st0) (liftIO $ hPutStrLn stderr ("<- " ++ showProcessMakerForUser maker)) return result where doOutput :: RunState text -> [Chunk text] -> IO [Chunk text] doOutput (RunState {_output = Dots n}) cs = putDotsLn n cs doOutput (RunState {_output = Silent}) cs = return cs doOutput (RunState {_output = All}) cs = writeOutput cs doOutput (RunState {_output = Indented, _outprefix = outp, _errprefix = errp}) cs = writeOutputIndented outp errp cs run :: forall m maker text char result. (RunM text char m, ProcessMaker maker, ProcessResult text result) => maker -> text -> m result run maker input = run' maker input >>= return . collectOutput -- | Output the dotified text of a chunk list with a newline at EOF. -- Returns the original list. putDotsLn :: (ListLikeProcessIO text char, Dot char) => Int -> [Chunk text] -> IO [Chunk text] putDotsLn cpd chunks = putDots cpd chunks >>= \ r -> System.IO.hPutStr stderr "\n" >> return r -- | Output the dotified text of a chunk list. Returns the original -- (undotified) list. putDots :: (ListLikeProcessIO text char, Dot char) => Int -> [Chunk text] -> IO [Chunk text] putDots charsPerDot chunks = evalStateT (mapM (\ x -> dotifyChunk charsPerDot x >>= mapM_ (lift . putChunk) >> return x) 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 text char m. (Monad m, ListLike text char, Dot char) => Int -> Chunk text -> StateT Int m [Chunk text] dotifyChunk charsPerDot chunk = case chunk of Stdout x -> doChars (ListLike.length x) Stderr x -> doChars (ListLike.length x) _ -> return [chunk] where doChars :: Int -> StateT Int m [Chunk text] doChars count = do remaining <- get let (count', remaining') = divMod (remaining + count) (fromIntegral charsPerDot) put remaining' if (count' > 0) then return [Stderr (ListLike.fromList (replicate count' dot))] else return [] -- | Write the Stdout chunks to stdout and the Stderr chunks to stderr. putChunk :: ListLikeProcessIO text char => Chunk text -> IO () putChunk (Stdout x) = ListLike.putStr x putChunk (Stderr x) = ListLike.hPutStr stderr x putChunk _ = return () writeOutputIndented :: (ListLikeProcessIO text char, Eq char, IsString text) => text -> text -> [Chunk text] -> IO [Chunk text] writeOutputIndented outp errp chunks = mapM (\(c, cs) -> mapM_ writeChunk cs >> return c) (indentChunks outp errp chunks) -- | Pure function to indent the text of a chunk list. indentChunks :: forall text char. (ListLikeProcessIO text char, Eq char, IsString text) => text -> text -> [Chunk text] -> [(Chunk text, [Chunk text])] indentChunks outp errp chunks = evalState (mapM (indentChunk nl outp errp) chunks) BOL where nl :: char nl = ListLike.head (fromString "\n" :: text) -- | 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 m text char. (Eq char, ListLike text char, MonadState BOL m) => char -> text -> text -> Chunk text -> m (Chunk text, [Chunk text]) indentChunk nl outp errp chunk = case chunk of Stdout x -> doText Stdout outp x >>= return . (chunk,) Stderr x -> doText Stderr errp x >>= return . (chunk,) _ -> return (chunk, [chunk]) where -- doText :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a] doText con pre x = do let (hd, tl) = ListLike.break (== nl) x hd' <- doHead con pre hd tl' <- doTail con pre tl return $ hd' <> tl' -- doHead :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a] doHead _ _ x | ListLike.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 | ListLike.null x = return [] doTail con pre x = do bol <- get put BOL tl <- doText con pre (ListLike.tail x) return $ (if bol == BOL then [con pre] else []) <> [con (singleton nl)] <> tl process-extras-0.7.4/src/System/Process/ByteString.hs0000644000000000000000000000275713235364332021030 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 instance ProcessText ByteString Word8 -- | 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.7.4/src/System/Process/Text.hs0000644000000000000000000000240413235364332017647 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Text where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif 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) instance ProcessText Text Char -- | 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.7.4/src/System/Process/ListLike.hs0000644000000000000000000001273613235364332020454 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 ( -- * Classes for process IO monad, output type, and creation type ListLikeProcessIO(forceOutput) , ProcessText , ProcessResult(pidf, outf, errf, codef, intf) , ProcessMaker(process, showProcessMakerForUser) -- * The generalized process runners , readCreateProcess , readCreateProcessStrict , readCreateProcessLazy , readCreateProcessWithExitCode , readProcessWithExitCode -- * Utility functions based on showCommandForUser , showCreateProcessForUser , showCmdSpecForUser -- * The Chunk type , Chunk(..) , collectOutput , foldOutput , writeOutput , writeChunk -- * Re-exports from process , CmdSpec(..) , CreateProcess(..) , proc , shell , showCommandForUser ) 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 Control.Applicative ((<$>), (<*>)) 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, showProcessMakerForUser), ListLikeProcessIO(forceOutput, readChunks), ProcessText, ProcessResult(pidf, outf, errf, codef, intf), readCreateProcessStrict, readCreateProcessLazy, readCreateProcessWithExitCode, readProcessWithExitCode, showCmdSpecForUser, showCreateProcessForUser) import System.Process.Text () import System.Process.Text.Builder () import System.Process.Text.Lazy () instance ProcessText String Char readCreateProcess :: (ProcessMaker maker, ProcessResult text result, ListLikeProcessIO text char) => maker -> text -> IO result readCreateProcess = readCreateProcessLazy -- | 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 => ProcessResult 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 => ProcessResult 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) -- ^ called when the process handle becomes known -> (a -> r) -- ^ stdout handler -> (a -> r) -- ^ stderr handler -> (SomeException -> r) -- ^ exception handler -> (ExitCode -> r) -- ^ exit code handler -> 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'. I -- usually use this after processing the chunk list to turn it into -- the (ExitCode, String, String) type returned by readProcessWithExitCode. collectOutput :: ProcessResult 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. -- Returns input list unmodified. writeOutput :: ListLikeIO a c => [Chunk a] -> IO [Chunk a] writeOutput [] = return [] writeOutput (x : xs) = (:) <$> writeChunk x <*> writeOutput xs writeChunk :: ListLikeIO a c => Chunk a -> IO (Chunk a) writeChunk x = foldOutput (\_ -> return x) (\s -> hPutStr stdout s >> return x) (\s -> hPutStr stderr s >> return x) (\_ -> return x) (\_ -> return x) x process-extras-0.7.4/src/System/Process/Chars.hs0000644000000000000000000000263413235364332017770 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Chars where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.DeepSeq (force) import qualified Control.Exception as C (evaluate) import Data.ListLike.IO (hGetContents) import Data.Text.Lazy (fromStrict, toChunks) import Data.ListLike.Chars (Chars(..)) import Prelude hiding (null) import System.Process import System.Process.Common import System.Exit (ExitCode) -- | Like 'System.Process.readProcessWithExitCode', but specialized for 'Text' instance ListLikeProcessIO Chars Char where forceOutput = C.evaluate . force readChunks h = (map (T . fromStrict) . toChunks) <$> hGetContents h -- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -- ^ command to run -> [String] -- ^ any arguments -> Chars -- ^ standard input -> IO (ExitCode, Chars, Chars) -- ^ exitcode, stdout, stderr readProcessWithExitCode = System.Process.Common.readProcessWithExitCode readCreateProcessWithExitCode :: CreateProcess -- ^ command and arguments to run -> Chars -- ^ standard input -> IO (ExitCode, Chars, Chars) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode process-extras-0.7.4/src/System/Process/Text/0000755000000000000000000000000013235364332017313 5ustar0000000000000000process-extras-0.7.4/src/System/Process/Text/Builder.hs0000644000000000000000000000263613235364332021244 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Text.Builder where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.DeepSeq (force) import qualified Control.Exception as C (evaluate) import Data.ListLike.IO (hGetContents) import Data.Text.Lazy (toChunks) import Data.Text.Lazy.Builder (Builder, fromText) import Prelude hiding (null) import System.Process import System.Process.Common import System.Exit (ExitCode) -- | Like 'System.Process.readProcessWithExitCode', but using 'Text' instance ListLikeProcessIO Builder Char where forceOutput = C.evaluate . force readChunks h = (map fromText . toChunks) <$> hGetContents h -- | Specialized version for backwards compatibility. readProcessWithExitCode :: FilePath -- ^ command to run -> [String] -- ^ any arguments -> Builder -- ^ standard input -> IO (ExitCode, Builder, Builder) -- ^ exitcode, stdout, stderr readProcessWithExitCode = System.Process.Common.readProcessWithExitCode readCreateProcessWithExitCode :: CreateProcess -- ^ command and arguments to run -> Builder -- ^ standard input -> IO (ExitCode, Builder, Builder) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = System.Process.Common.readCreateProcessWithExitCode process-extras-0.7.4/src/System/Process/Text/Lazy.hs0000644000000000000000000000256013235364332020571 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Text.Lazy where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.DeepSeq (force) import qualified Control.Exception as C (evaluate) import Data.ListLike.IO (hGetContents) import Data.Text.Lazy (Text, fromStrict, toChunks) import Prelude hiding (null) import System.Process import System.Process.Common import System.Exit (ExitCode) instance ProcessText Text Char -- | Like 'System.Process.readProcessWithExitCode', but using 'Text' instance ListLikeProcessIO Text Char where forceOutput = C.evaluate . force readChunks h = (map fromStrict . 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.7.4/src/System/Process/ByteString/0000755000000000000000000000000013235364332020461 5ustar0000000000000000process-extras-0.7.4/src/System/Process/ByteString/Lazy.hs0000644000000000000000000000317013235364332021735 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 instance ProcessText ByteString Word8 -- | 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