process-extras-0.3.3.5/0000755000000000000000000000000012535170010013022 5ustar0000000000000000process-extras-0.3.3.5/README.md0000644000000000000000000000054712535170010014307 0ustar0000000000000000# About Extra functionality for the [Process library](http://hackage.haskell.org/package/process). # 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). process-extras-0.3.3.5/.travis.yml0000644000000000000000000000005412535170010015132 0ustar0000000000000000language: haskell ghc: - 7.4 - 7.6 - 7.8 process-extras-0.3.3.5/process-extras.cabal0000644000000000000000000000206612535170010016774 0ustar0000000000000000Name: process-extras Version: 0.3.3.5 Synopsis: Process extras Description: Extra functionality for the Process library . 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 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, ListLike >= 4, process, bytestring, text, deepseq process-extras-0.3.3.5/LICENSE0000644000000000000000000000206512535170010014032 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.3.3.5/Setup.hs0000644000000000000000000000005612535170010014457 0ustar0000000000000000import Distribution.Simple main = defaultMain process-extras-0.3.3.5/src/0000755000000000000000000000000012535170010013611 5ustar0000000000000000process-extras-0.3.3.5/src/Utils.hs0000644000000000000000000000044012535170010015243 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.3.3.5/src/System/0000755000000000000000000000000012535170010015075 5ustar0000000000000000process-extras-0.3.3.5/src/System/Process/0000755000000000000000000000000012535170010016513 5ustar0000000000000000process-extras-0.3.3.5/src/System/Process/Common.hs0000644000000000000000000002077112535170010020306 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# 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 (null) import Data.ListLike.IO (ListLikeIO, hGetContents, hPutStr) import Data.Monoid ((<>)) 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 (pure, (<$>), (<*>)) import Data.Monoid (Monoid(mempty, mappend)) #else import GHC.Generics #if __GLASGOW_HASKELL__ <= 710 deriving instance Generic ExitCode #endif #endif -- | This instance lets us use DeepSeq's force function on a stream of Chunks. instance NFData ExitCode 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 unless (null input) $ do ignoreResourceVanished (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 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 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 $ (<>) <$> 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 `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 = 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 process-extras-0.3.3.5/src/System/Process/Text.hs0000644000000000000000000000225112535170010017773 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.3.3.5/src/System/Process/ByteString.hs0000644000000000000000000000271012535170010021141 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.3.3.5/src/System/Process/ListLike.hs0000644000000000000000000001005112535170010020564 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 , showCreateProcessForUser , showCmdSpecForUser ) where import Control.DeepSeq (force) import Control.Exception as C (evaluate, SomeException, throw) import Data.ListLike.IO (hGetContents) #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.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. 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 process-extras-0.3.3.5/src/System/Process/ByteString/0000755000000000000000000000000012535170010020605 5ustar0000000000000000process-extras-0.3.3.5/src/System/Process/ByteString/Lazy.hs0000644000000000000000000000312112535170010022055 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 process-extras-0.3.3.5/src/System/Process/Text/0000755000000000000000000000000012535170010017437 5ustar0000000000000000process-extras-0.3.3.5/src/System/Process/Text/Lazy.hs0000644000000000000000000000246212535170010020716 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