process-extras 0.3.3.8 → 0.3.4
raw patch · 2 files changed
+29/−20 lines, 2 filesdep ~basedep ~deepseq
Dependency ranges changed: base, deepseq
Files
- process-extras.cabal +1/−1
- src/System/Process/Common.hs +28/−19
process-extras.cabal view
@@ -1,5 +1,5 @@ Name: process-extras-Version: 0.3.3.8+Version: 0.3.4 Synopsis: Process extras Description: Extends <http://hackage.haskell.org/package/process>. Read process input and output as ByteStrings or
src/System/Process/Common.hs view
@@ -1,15 +1,17 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module System.Process.Common ( ProcessMaker(process) , ListLikeProcessIO(forceOutput, readChunks)- , ProcessOutput(pidf, outf, errf, intf, codef)+ , ProcessOutput(ProcessInput, pidf, outf, errf, intf, codef) , readProcessWithExitCode , readCreateProcessWithExitCode , readCreateProcess@@ -20,7 +22,7 @@ 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 as ListLike (null) import Data.ListLike.IO (ListLikeIO, hGetContents, hPutStr) import Data.Monoid ((<>)) import Generics.Deriving.Instances ()@@ -63,14 +65,16 @@ 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+class Monoid (ProcessInput a) => ProcessOutput a where+ type ProcessInput a+ pidf :: ProcessHandle -> a+ outf :: ProcessInput a -> a+ errf :: ProcessInput a -> a+ intf :: SomeException -> a+ codef :: ExitCode -> a -instance ListLikeProcessIO a c => ProcessOutput a (ExitCode, a, a) where+instance ListLikeProcessIO a c => ProcessOutput (ExitCode, a, a) where+ type ProcessInput (ExitCode, a, a) = a pidf _ = mempty codef c = (c, mempty, mempty) outf x = (mempty, x, mempty)@@ -105,7 +109,7 @@ -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr readCreateProcessWithExitCode = readCreateProcess -readCreateProcess :: (ProcessMaker maker, ProcessOutput a b, ListLikeProcessIO a c) => maker -> a -> IO b+readCreateProcess :: (ProcessMaker maker, ProcessOutput b, ListLikeProcessIO (ProcessInput b) c) => maker -> ProcessInput b -> IO b readCreateProcess maker input = mask $ \restore -> do (inh, outh, errh, pid) <- process maker flip onException@@ -118,9 +122,14 @@ -- 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+ -- now write and flush any input. Catch and ignore+ -- ResourceVanished to avoid crashes when the process we are+ -- writing to exits prematurely.+ ignoreResourceVanished $ do+ unless (ListLike.null input) $ do+ hPutStr inh input+ hFlush inh+ hClose inh -- stdin has been fully written -- wait on the output out <- waitOut@@ -142,7 +151,7 @@ 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 :: (ProcessMaker maker, ProcessOutput b, ListLikeProcessIO (ProcessInput b) c) => maker -> ProcessInput b -> IO b readCreateProcessLazy maker input = mask $ \restore -> do (inh, outh, errh, pid) <- process maker onException@@ -158,19 +167,19 @@ waitForProcess pid) -- | Helper function for readCreateProcessLazy.-readInterleaved :: (ListLikeProcessIO a c, ProcessOutput a b) =>- [(a -> b, Handle)] -> IO b -> IO b+readInterleaved :: (ListLikeProcessIO (ProcessInput b) c, ProcessOutput b) =>+ [(ProcessInput b -> 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' :: forall b c. (ListLikeProcessIO (ProcessInput b) c, ProcessOutput b) =>+ [(ProcessInput b -> 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 :: (ProcessInput b -> b) -> Handle -> IO () readHandle f h = do cs <- readChunks h -- If the type returned as stdout and stderr is lazy we need