diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -55,7 +55,7 @@ Take a look at these other libraries; they might meet your needs. -### Subprocesses generally +### Dealing specifically with subprocesses and streaming * process-streaming @@ -64,6 +64,10 @@ * pipes-shell https://hackage.haskell.org/package/pipes-shell + +* Data.Conduit.Process + +https://www.fpcomplete.com/user/snoyberg/library-documentation/data-conduit-process ### Larger scripting frameworks diff --git a/lib/Pipes/Cliff.hs b/lib/Pipes/Cliff.hs --- a/lib/Pipes/Cliff.hs +++ b/lib/Pipes/Cliff.hs @@ -15,20 +15,16 @@ -- -- __Use the @-threaded@ GHC option__ when compiling your programs or -- when using GHCi. Internally, this module uses --- 'System.Process.waitForProcess' from the "System.Process" module; --- it's also quite likely that you will use this function when you --- write code using this library. As the documentation for --- 'waitForProcess' states, you must use the @-threaded@ option to --- prevent every thread in the system from suspending when you use --- 'waitForProcess'. So, if your program experiences deadlocks, be --- sure you used the @-threaded@ option. +-- 'System.Process.waitForProcess' from the "System.Process" module. +-- As the documentation for 'waitForProcess' states, you must use the +-- @-threaded@ option to prevent every thread in the system from +-- suspending when 'waitForProcess' is used. So, if your program +-- experiences deadlocks, be sure you used the @-threaded@ option. -- --- This module relies on the "Pipes", "Pipes.Safe", and --- "System.Process" modules. You will want to have basic --- familiarity with what all of those modules do before using this --- module. It uses "Control.Concurrent.Async" and --- "Pipes.Concurrent" behind the scenes; you don't need to know how --- these work unless you're curious. +-- This module relies on the "Pipes", "Pipes.Safe", +-- "Control.Concurrent.Async", and "System.Process" modules. You will +-- want to have basic familiarity with what all of those modules do +-- before using this module. -- -- All communcation with subprocesses is done with strict -- 'ByteString's. If you are dealing with textual data, the @text@ @@ -58,9 +54,15 @@ , procSpec , squelch + -- * Type synonyms + , Stdin + , Outstream + , Stdout + , Stderr + -- * Creating processes -- $process - , pipeNone + , pipeInput , pipeOutput , pipeError @@ -69,45 +71,53 @@ , pipeOutputError , pipeInputOutputError - -- * Background operations - - -- | Often it is necessary to run threads in the background; in - -- addition, all subprocesses run in the background. These - -- functions allow you to launch threads in the background and to - -- wait on background threads and subprocesses. - + -- * 'Proxy' combinators + , forwardRight + , wrapRight , conveyor - , background + , safeEffect + , immortal + + -- * Querying and terminating the process + , ProcessHandle + , originalCreateProcess + , isStillRunning , waitForProcess - , waitForThread + , terminateProcess + + -- * Exception safety + -- | These are some simple combinators built with + -- 'Control.Exception.bracket'; feel free to use your own favorite + -- idioms for exception safety. + , withProcess + , withConveyor + -- * Errors and warnings -- | You will only need what's in this section if you want to -- examine errors more closely. , Activity(..) + , Outbound(..) , HandleDesc(..) - , HandleOopsie(..) , Oopsie(..) -- * Re-exports -- $reexports - , module Control.Concurrent.MVar + , module Control.Concurrent.Async , module Pipes , module Pipes.Safe , module System.Exit - , module System.Process -- * Some design notes -- $designNotes ) where +import Control.Concurrent.Async import Pipes.Cliff.Core import Pipes -import Pipes.Safe +import Pipes.Safe (runSafeT) import System.Exit -import System.Process (ProcessHandle) -import Control.Concurrent.MVar {- $process @@ -125,46 +135,49 @@ with standard error. A 'Producer' is returned for standard output and a 'Consumer' for standard input. -If you are creating a 'Proxy' for only one stream (for instance, -you're using 'pipeOutput') then a single 'Proxy' is returned to you. -That 'Proxy' manages all the resources it creates; so, for example, -when you ultimately run your 'Effect', the process is created and then -destroyed when the 'MonadSafe' computation completes. +Each function also returns a 'ProcessHandle'; this is not the same +'ProcessHandle' that you will find in "System.Process". You can use +this 'ProcessHandle' to obtain some information about the process that +is created and to get the eventual 'ExitCode'. -If you are creating a 'Proxy' for more than one stream (for -instance, you're using 'pipeInputOutput') then the multiple 'Proxy' -are returned to you in a tuple in the 'MonadSafe' computation. The -'MonadSafe' computation will make sure that the resulting process -and handles are destroyed when you exit the 'MonadSafe' computation. -In such a case, you must make sure that you don't try to use the -streams outside of the 'MonadSafe' computation, because the -subprocess will already be destroyed. To make sure you are done -using the streams before leaving the 'MonadSafe' computation, you -will want to use 'waitForProcess' for one or more processes that you -are most interested in. +Every time you create a process with one of these functions, some +additional behind-the-scenes resources are created, such as some +threads to move data to and from the process. In normal usage, these +threads will be cleaned up after the process exits. However, if +exceptions are thrown, there could be resource leaks. Applying +'terminateProcess' to a 'ProcessHandle' makes a best effort to clean +up all the resources that Cliff may create, including the process +itself and any additional threads. To guard against resource leaks, +use the functions found in "Control.Exception" or in +"Control.Monad.Catch". "Control.Monad.Catch" provides operations that +are the same as those in "Control.Exception", but they are not limited +to 'IO'. -Every function in this section (except for the 'pipeNone' function) -returns a value of type @(a, h)@, where @a@ is the set of 'Proxy', -and @h@ is the 'ProcessHandle'; that means the functions that return -multiple 'Proxy' have a nested return type. That allows you to use -'fst' and 'snd' to pull out the part you are interested in. It -would have been more consistent for 'pipeNone' to return -@((), ProcessHandle)@ but that just seemed silly. +I say that 'terminateProcess' \"makes a best effort\" to release +resources because in UNIX it merely sends a @SIGTERM@ to the process. +That should kill well-behaved processes, but 'terminateProcess' does +not send a @SIGKILL@. 'terminateProcess' always closes all handles +associated with the process and it kills all Haskell threads that were +moving data to and from the process. ('terminateProcess' does not +kill threads it does not know about, such as threads you created with +'conveyor'.) +There is no function that will create a process that has no 'Proxy' +at all. For that, just use 'System.Process.createProcess' in +"System.Process". + -} {- $reexports - * "Control.Concurrent.MVar" reexports all bindings + * "Control.Concurrent.Async" reexports all bindings * "Pipes" reexports all bindings - * "Pipes.Safe" reexports all bindings + * "Pipes.Safe" reexports 'runSafeT' * "System.Exit" reexports all bindings - * "System.Process" reexports 'ProcessHandle' - -} {- $designNotes @@ -178,9 +191,18 @@ she should, because not all UNIX processes deal with encoded textual data. -Second, I paid meticulous attention to resource management. -Resources are deterministically destroyed immediately after -use. This eliminates many bugs. +Second, I paid meticulous attention to resource management. Resources +are deterministically destroyed immediately after use. This +eliminates many bugs. Even so, I decided to leave it up to the user +to use something like 'Control.Exception.bracket' to ensure that all +resources are cleaned up if there is an exception. Originally I tried +to have the library do this, but that turned out not to be very +composable. There are already many exception-handling mechanisms +available in "Control.Exception", "Pipes.Safe", and +"Control.Monad.Catch", and it seems best to let the user choose how to +handle this issue; she can just perform a 'Control.Exception.bracket' +and may combine this with the @ContT@ monad in @transformers@ or @mtl@ +if she wishes, or perhaps with the @managed@ library. You might wonder why, if you are using an external process as a pipeline, why can't you create, well, a 'Pipe'? Wouldn't diff --git a/lib/Pipes/Cliff/Core.hs b/lib/Pipes/Cliff/Core.hs --- a/lib/Pipes/Cliff/Core.hs +++ b/lib/Pipes/Cliff/Core.hs @@ -1,709 +1,1007 @@ -{-# LANGUAGE FlexibleContexts #-} - --- | This contains the innards of Cliff. You probably won't need --- anything that's in here; "Pipes.Cliff" re-exports the most useful --- bindings. But nothing will break if you use what's in here, so --- it's here if you need it. -module Pipes.Cliff.Core where - -import System.Environment -import Data.List (intersperse) -import Control.Exception (IOException) -import System.IO -import qualified System.Process as Process -import System.Process (ProcessHandle) -import Pipes -import Pipes.Safe -import qualified Data.ByteString as BS -import qualified Pipes.Concurrent as PC -import Data.ByteString (ByteString) -import Control.Concurrent.Async -import System.Exit - --- * Data types - --- | Like 'Process.CmdSpec' in "System.Process", but also has an --- instance for 'Show'. -data CmdSpec - = ShellCommand String - | RawCommand FilePath [String] - deriving (Eq, Ord, Show) - -convertCmdSpec :: CmdSpec -> Process.CmdSpec -convertCmdSpec (ShellCommand s) = Process.ShellCommand s -convertCmdSpec (RawCommand p ss) = Process.RawCommand p ss - --- ** Errors - --- | When dealing with a 'Handle', errors can occur when reading from, --- writing to, or closing the handle. -data Activity - = Reading - | Writing - | Closing - deriving (Eq, Ord, Show) - --- | Describes a handle. From the perspective of the subprocess; for --- example, 'Input' means that this handle is connected to the --- process's standard input. -data HandleDesc - = Input - | Output - | Error - deriving (Eq, Ord, Show) - --- | Describes IO errors tha occur when dealing with a 'Handle'. -data HandleOopsie = HandleOopsie Activity HandleDesc - deriving (Eq,Show) - --- | Describes all IO exceptions. The 'Oopsie' contains the --- 'IOException' itself, along with the 'CmdSpec' that was running --- when the exception occurred. If the exception occurred while --- dealing with a 'Handle', there is also a 'HandleOopsie'. If there --- is no 'HandleOopsie', this means that the exception arose when --- running 'terminateProcess'. --- --- The exceptions that are caught and placed into an 'Oopsie' may --- arise from reading data from or writing data to a 'Handle'. In --- these errors, the associated 'Producer' or 'Consumer' will --- terminate (which may trigger various cleanup actions in the --- 'MonadSafe' computation) but the exception itself is not re-thrown; --- rather, it is passed to the 'handler'. Similarly, an exception may --- occur while closing a handle; these exceptions are caught, not --- rethrown, and are passed to the 'handler'. If an exception arises --- when terminating a process (I'm not sure this is possible) then it --- is also caught, not rethrown, and passed to the 'handler'. --- --- If an exception arises when creating a process--such as a command --- not being found--the exception is /not/ caught, handled, or passed --- to the 'handler'. Also, an 'Oopsie' is created only for an --- 'IOException'; no other exceptions of any kind are caught or --- handled. However, exceptions of any kind will still trigger --- appropriate cleanup actions in the 'MonadSafe' computation. -data Oopsie = Oopsie (Maybe HandleOopsie) CmdSpec IOException - deriving (Eq, Show) - --- | Formats an 'Oopsie' for display. -renderOopsie - :: String - -- ^ The name of the currently runnning program - -> Oopsie - -> String -renderOopsie pn (Oopsie mayHan cmd ioe) = - pn ++ ": warning: when running command " - ++ renderCommand cmd ++ ": " ++ renderMayHan mayHan - ++ ": " ++ show ioe - where - renderCommand (ShellCommand str) = show str - renderCommand (RawCommand fp ss) - = concat . intersperse " " . map show - $ fp : ss - - renderMayHan Nothing = "when terminating process" - renderMayHan (Just (HandleOopsie act desc)) = - "when " ++ actStr ++ " " ++ descStr - where - actStr = case act of - Reading -> "reading from" - Writing -> "writing to" - Closing -> "closing the handle associated with" - descStr = "standard " ++ case desc of - Input -> "input" - Output -> "output" - Error -> "error" - --- | The default handler when receiving an 'Oopsie'; simply uses --- 'renderOopsie' to format it nicely and put it on standard error. -defaultHandler :: Oopsie -> IO () -defaultHandler oops = do - pn <- getProgName - hPutStrLn stderr $ renderOopsie pn oops - --- ** Configuration types - --- | How will the subprocess get its information for this stream? A --- 'NonPipe' is used for streams that will not be assigned to a --- 'Proxy' but, instead, will be inherited from the parent or directed --- from an existing 'Handle'. -data NonPipe - = Inherit - -- ^ Use whatever stream that the parent process has. - | UseHandle Handle - -- ^ Use the given handle for input or output - -convertNonPipe :: Maybe NonPipe -> Process.StdStream -convertNonPipe a = case a of - Nothing -> Process.CreatePipe - Just Inherit -> Process.Inherit - Just (UseHandle h) -> Process.UseHandle h - --- | Like 'System.Process.CreateProcess' in "System.Process", --- this gives the necessary information to create a subprocess. All --- but one of these fields is also present in --- 'System.Process.CreateProcess', and they all have the same meaning; --- the only field that is different is the 'handler' field. -data CreateProcess = CreateProcess - { cmdspec :: CmdSpec - -- ^ Executable and arguments, or shell command - - , cwd :: Maybe FilePath - -- ^ A new current working directory for the subprocess; if - -- 'Nothing', use the calling process's working directory. - - , env :: Maybe [(String, String)] - -- ^ The environment for the subprocess; if 'Nothing', use the - -- calling process's working directory. - - , close_fds :: Bool - -- ^ If 'True', close all file descriptors other than the standard - -- descriptors. See the documentation for - -- 'System.Process.close_fds' for details on how this works in - -- Windows. - - , create_group :: Bool - -- ^ If 'True', create a new process group. - - , delegate_ctlc :: Bool - -- ^ See 'System.Process.delegate_ctlc' in the "System.Process" - -- module for details. - - , handler :: Oopsie -> IO () - -- ^ Whenever an IO exception arises during the course of various - -- IO actios, the exception is caught and placed into an 'Oopsie' - -- that indicates why and where the exception happened. The - -- 'handler' determines what happens when an 'Oopsie' comes in. - -- See 'Oopsie' for details. - -- - -- The default 'handler' created by 'procSpec' is - -- 'defaultHandler', which will simply print the exceptions to - -- standard error. You may not want to see the exceptions at all. - -- For example, many exceptions come from broken pipes. A broken - -- pipe might be entirely normal in your circumstance. For - -- example, if you are streaming a large set of values to a pager - -- such as @less@ and you expect that the user will often quit the - -- pager without viewing the whole result, a broken pipe will - -- result, which will print a warning message. That can be a - -- nuisance. - -- - -- If you don't want to see the exceptions at all, just set - -- 'handler' to 'squelch', which simply discards the exceptions. - -- - -- Conceivably you could rig up an elaborate mechanism that puts - -- the 'Oopsie's into a "Pipes.Concurrent" mailbox or something. - -- Indeed, when using 'defaultHandler' each thread will print its - -- warnings to standard error at any time. If you are using - -- multiple processes and each prints warnings at the same time, - -- total gibberish can result as the text gets mixed in. You - -- could solve this by putting the errors into a - -- "Pipes.Concurrent" mailbox and having a single thread print the - -- errors; building this sort of functionality directly in to the - -- library would clutter up the API somewhat so I have been - -- reluctant to do it. - } - --- | Do not show or do anything with exceptions; useful to use as a --- 'handler'. -squelch :: Monad m => a -> m () -squelch = const (return ()) - --- | Create a 'CreateProcess' record with default settings. The --- default settings are: --- --- * a raw command (as opposed to a shell command) is created --- --- * the current working directory is not changed from the parent process --- --- * the environment is not changed from the parent process --- --- * the parent's file descriptors (other than standard input, --- standard output, and standard error) are inherited --- --- * no new process group is created --- --- * 'delegate_ctlc' is 'False' --- --- * 'storeProcessHandle' is 'Nothing' --- --- * 'handler' is 'defaultHandler' - -procSpec - :: String - -- ^ The name of the program to run, such as @less@. - -> [String] - -- ^ Command-line arguments - -> CreateProcess -procSpec prog args = CreateProcess - { cmdspec = RawCommand prog args - , cwd = Nothing - , env = Nothing - , close_fds = False - , create_group = False - , delegate_ctlc = False - , handler = defaultHandler - } - -convertCreateProcess - :: Maybe NonPipe - -> Maybe NonPipe - -> Maybe NonPipe - -> CreateProcess - -> Process.CreateProcess -convertCreateProcess inp out err a = Process.CreateProcess - { Process.cmdspec = convertCmdSpec $ cmdspec a - , Process.cwd = cwd a - , Process.env = env a - , Process.std_in = conv inp - , Process.std_out = conv out - , Process.std_err = conv err - , Process.close_fds = close_fds a - , Process.create_group = create_group a - , Process.delegate_ctlc = delegate_ctlc a - } - where - conv = convertNonPipe - --- * ErrSpec - --- | Contains data necessary to deal with exceptions. -data ErrSpec = ErrSpec - { esErrorHandler :: Oopsie -> IO () - , esCmdSpec :: CmdSpec - } - -makeErrSpec - :: CreateProcess - -> ErrSpec -makeErrSpec cp = ErrSpec - { esErrorHandler = handler cp - , esCmdSpec = cmdspec cp - } - - --- * Exception handling - --- | Sends an exception using the exception handler specified in the --- 'ErrSpec'. -handleException - :: MonadIO m - => Maybe HandleOopsie - -> IOException - -> ErrSpec - -> m () -handleException mayOops exc ev = liftIO $ sender oops - where - spec = esCmdSpec ev - sender = esErrorHandler ev - oops = Oopsie mayOops spec exc - - --- | Run an action, taking all IO errors and sending them to the handler. -handleErrors - :: (MonadCatch m, MonadIO m) - => Maybe HandleOopsie - -> ErrSpec - -> m () - -> m () -handleErrors mayHandleOops ev act = catch act catcher - where - catcher e = liftIO $ hndlr oops - where - spec = esCmdSpec ev - hndlr = esErrorHandler ev - oops = Oopsie mayHandleOops spec e - - --- | Close a handle. Catches any exceptions and passes them to the handler. -closeHandleNoThrow - :: (MonadCatch m, MonadIO m) - => Handle - -> HandleDesc - -> ErrSpec - -> m () -closeHandleNoThrow hand desc ev = handleErrors (Just (HandleOopsie Closing desc)) - ev (liftIO $ hClose hand) - --- | Terminates a process; sends any IO errors to the handler. -terminateProcess - :: (MonadCatch m, MonadIO m) - => Process.ProcessHandle - -> ErrSpec - -> m () -terminateProcess han ev = do - _ <- handleErrors Nothing ev (liftIO (Process.terminateProcess han)) - handleErrors Nothing ev . liftIO $ do - _ <- Process.waitForProcess han - return () - - --- | Acquires a resource and ensures it will be destroyed when the --- 'MonadSafe' computation completes. -acquire - :: MonadSafe m - => Base m a - -- ^ Acquirer. - -> (a -> Base m ()) - -- ^ Destroyer. - -> m a -acquire acq rel = mask $ \restore -> do - a <- liftBase acq - _ <- register (rel a) - restore $ return a - - --- * Threads - --- | Runs a thread in the background. The thread is terminated when --- the 'MonadSafe' computation completes. -background - :: MonadSafe m - => IO a - -> m (Async a) -background act = acquire (liftIO $ async act) (liftIO . cancel) - --- | Runs in the background an effect, typically one that is moving --- data from one process to another. For examples of its usage, see --- "Pipes.Cliff.Examples". The associated thread is killed when the --- 'MonadSafe' computation completes. -conveyor :: MonadSafe m => Effect (SafeT IO) () -> m () -conveyor efct - = (background . liftIO . runSafeT . runEffect $ efct) >> return () - - --- | A version of 'Control.Concurrent.Async.wait' with an overloaded --- 'MonadIO' return type. Allows you to wait for the return value of --- threads launched with 'background'. If the thread throws an --- exception, 'waitForThread' will throw that same exception. -waitForThread :: MonadIO m => Async a -> m a -waitForThread = liftIO . wait - --- | An overloaded version of the 'Process.waitForProcess' from --- "System.Process". -waitForProcess :: MonadIO m => ProcessHandle -> m ExitCode -waitForProcess h = liftIO $ Process.waitForProcess h - - --- * Mailboxes - --- | A buffer that holds 1 message. I have no idea if this is the --- ideal size. Don't use an unbounded buffer, though, because with --- unbounded producers an unbounded buffer will fill up your RAM. --- --- Since the buffer just holds one size, you might think \"why not --- just use an MVar\"? At least, I have been silly enough to think --- that. Using @Pipes.Concurrent@ also give the mailbox the ability --- to be sealed; sealing the mailbox signals to the other side that it --- won't be getting any more input or be allowed to send any more --- output, which tells the whole pipeline to start shutting down. -messageBuffer :: PC.Buffer a -messageBuffer = PC.bounded 1 - --- | Creates a new mailbox and returns 'Proxy' that stream values --- into and out of the mailbox. Each 'Proxy' is equipped with a --- finalizer that will seal the mailbox immediately after production --- or consumption has completed, even if such completion is not due --- to an exhausted mailbox. This will signal to the other side of --- the mailbox that the mailbox is sealed. -newMailbox - :: (MonadIO m, MonadSafe mi, MonadSafe mo) - => m (Consumer a mi (), Producer a mo ()) -newMailbox = do - (toBox, fromBox, seal) <- liftIO $ PC.spawn' messageBuffer - let csmr = register (liftIO $ PC.atomically seal) - >> PC.toOutput toBox - pdcr = register (liftIO $ PC.atomically seal) - >> PC.fromInput fromBox - return (csmr, pdcr) - - --- * Production from and consumption to 'Handle's - --- | I have no idea what this should be. I'll start with a simple --- small value and see how it works. -bufSize :: Int -bufSize = 1024 - - --- | Create a 'Producer' that produces from a 'Handle'. Takes --- ownership of the 'Handle'; closes it when the 'Producer' --- terminates. If any IO errors arise either during production or --- when the 'Handle' is closed, they are caught and passed to the --- handler. -produceFromHandle - :: (MonadSafe m, MonadCatch (Base m)) - => HandleDesc - -> Handle - -> ErrSpec - -> Producer ByteString m () -produceFromHandle hDesc h ev = do - _ <- register (closeHandleNoThrow h hDesc ev) - let hndlr e = lift $ handleException (Just oops) e ev - oops = HandleOopsie Reading hDesc - produce = liftIO (BS.hGetSome h bufSize) >>= go - go bs - | BS.null bs = return () - | otherwise = yield bs >> produce - produce `catch` hndlr - - --- | Runs a 'Consumer'; registers the handle so that it is closed --- when consumption finishes. If any IO errors arise either during --- consumption or when the 'Handle' is closed, they are caught and --- passed to the handler. -consumeToHandle - :: (MonadSafe m, MonadCatch (Base m)) - => Handle - -> ErrSpec - -> Consumer ByteString m () -consumeToHandle h ev = do - _ <- register $ closeHandleNoThrow h Input ev - let hndlr e = lift $ handleException (Just oops) e ev - oops = HandleOopsie Writing Input - go = do - bs <- await - liftIO $ BS.hPut h bs - go - go `catch` hndlr - - --- | Creates a background thread that will consume to the given Handle --- from the given Producer. Takes ownership of the 'Handle' and --- closes it when done. -backgroundSendToProcess - :: MonadSafe m - => Handle - -> Producer ByteString (SafeT IO) () - -> ErrSpec - -> m () -backgroundSendToProcess han prod ev = background act >> return () - where - csmr = consumeToHandle han ev - act = runSafeT . runEffect $ prod >-> csmr - --- | Creates a background thread that will produce from the given --- Handle into the given Consumer. Takes possession of the Handle and --- closes it when done. -backgroundReceiveFromProcess - :: MonadSafe m - => HandleDesc - -> Handle - -> Consumer ByteString (SafeT IO) () - -> ErrSpec - -> m () -backgroundReceiveFromProcess desc han csmr ev = background act >> return () - where - prod = produceFromHandle desc han ev - act = runSafeT . runEffect $ prod >-> csmr - --- | Does everything necessary to run a 'Handle' that is created to a --- process standard input. Creates mailbox, runs background thread --- that pumps data out of the mailbox and into the process standard --- input, and returns a Consumer that consumes and places what it --- consumes into the mailbox for delivery to the background process. -runInputHandle - :: (MonadSafe m, MonadSafe mi) - => Handle - -> ErrSpec - -> m (Consumer ByteString mi ()) -runInputHandle inp ev = do - (toMbox, fromMbox) <- liftIO newMailbox - backgroundSendToProcess inp fromMbox ev - return toMbox - - --- | Does everything necessary to run a 'Handle' that is created to a --- process standard output or standard error. Creates mailbox, runs --- background thread that pumps data from the process output 'Handle' --- into the mailbox, and returns a Producer that produces what comes --- into the mailbox. -runOutputHandle - :: (MonadSafe m, MonadSafe mo) - => HandleDesc - -> Handle - -> ErrSpec - -> m (Producer ByteString mo ()) -runOutputHandle desc out ev = do - (toMbox, fromMbox) <- liftIO $ newMailbox - backgroundReceiveFromProcess desc out toMbox ev - return fromMbox - - --- * Creating subprocesses - - --- | Creates a subprocess. Registers destroyers for each handle --- created, as well as for the ProcessHandle. -createProcess - :: (MonadSafe m, MonadCatch (Base m)) - => Process.CreateProcess - -> ErrSpec - -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -createProcess cp ev = mask $ \restore -> do - (mayIn, mayOut, mayErr, han) <- liftIO $ Process.createProcess cp - let close mayHan desc = maybe (return ()) - (\h -> closeHandleNoThrow h desc ev) mayHan - _ <- register (close mayIn Input) - _ <- register (close mayOut Output) - _ <- register (close mayErr Error) - _ <- register (terminateProcess han ev) - restore $ return (mayIn, mayOut, mayErr, han) - - --- | Convenience wrapper for 'createProcess'. The subprocess is --- terminated and all its handles destroyed when the 'MonadSafe' --- computation completes. -runCreateProcess - :: (MonadSafe m, MonadCatch (Base m)) - => Maybe NonPipe - -- ^ Standard input - -> Maybe NonPipe - -- ^ Standard output - -> Maybe NonPipe - -- ^ Standard error - -> CreateProcess - -> m (Maybe Handle, Maybe Handle, Maybe Handle, ErrSpec, ProcessHandle) -runCreateProcess inp out err cp = do - let ev = makeErrSpec cp - (inp', out', err', phan) <- - createProcess (convertCreateProcess inp out err cp) ev - return (inp', out', err', ev, phan) - --- * Creating Proxy - - --- | Do not create any 'Proxy' to or from the process. -pipeNone - :: (MonadSafe m, MonadCatch (Base m)) - => NonPipe - -- ^ Standard input - -> NonPipe - -- ^ Standard output - -> NonPipe - -- ^ Standard error - -> CreateProcess - -> m ProcessHandle -pipeNone inp out err cp = do - (_, _, _, _, phan) <- - runCreateProcess (Just inp) (Just out) (Just err) cp - return phan - - --- | Create a 'Consumer' for standard input. -pipeInput - :: (MonadSafe mi, MonadSafe m, MonadCatch (Base m)) - => NonPipe - -- ^ Standard output - -> NonPipe - -- ^ Standard error - -> CreateProcess - -> m (Consumer ByteString mi (), ProcessHandle) - -- ^ A 'Consumer' for standard input -pipeInput out err cp = do - (Just inp, _, _, ev, phan) <- - runCreateProcess Nothing (Just out) (Just err) cp - ih <- runInputHandle inp ev - return (ih, phan) - - - --- | Create a 'Producer' for standard output. -pipeOutput - :: (MonadSafe mo, MonadSafe m, MonadCatch (Base m)) - => NonPipe - -- ^ Standard input - -> NonPipe - -- ^ Standard error - -> CreateProcess - -> m (Producer ByteString mo (), ProcessHandle) - -- ^ A 'Producer' for standard output -pipeOutput inp err cp = do - (_, Just out, _, ev, phan) <- runCreateProcess (Just inp) - Nothing (Just err) cp - oh <- runOutputHandle Output out ev - return (oh, phan) - --- | Create a 'Producer' for standard error. -pipeError - :: (MonadSafe m, MonadCatch (Base m)) - => NonPipe - -- ^ Standard input - -> NonPipe - -- ^ Standard output - -> CreateProcess - -> m (Producer ByteString m (), ProcessHandle) - -- ^ A 'Producer' for standard error -pipeError inp out cp = do - (_, _, Just err, ev, phan) <- runCreateProcess (Just inp) (Just out) Nothing cp - eh <- runOutputHandle Error err ev - return (eh, phan) - --- | Create a 'Consumer' for standard input and a 'Producer' for --- standard output. -pipeInputOutput - :: (MonadSafe mi, MonadSafe mo, MonadSafe m, MonadCatch (Base m)) - => NonPipe - -- ^ Standard error - -> CreateProcess - -> m ((Consumer ByteString mi (), Producer ByteString mo ()), ProcessHandle) - -- ^ A 'Consumer' for standard input, a 'Producer' for standard - -- output -pipeInputOutput err cp = do - (Just inp, Just out, _, ev, phan) <- - runCreateProcess Nothing Nothing (Just err) cp - ih <- runInputHandle inp ev - oh <- runOutputHandle Output out ev - return ((ih, oh), phan) - --- | Create a 'Consumer' for standard input and a 'Producer' for --- standard error. -pipeInputError - :: (MonadSafe mi, MonadSafe me, MonadSafe m, MonadCatch (Base m)) - => NonPipe - -- ^ Standard output - -> CreateProcess - -> m ( (Consumer ByteString mi (), Producer ByteString me ()) - , ProcessHandle) - -- ^ A 'Consumer' for standard input, a 'Producer' for standard - -- error -pipeInputError out cp = do - (Just inp, _, Just err, ev, phan) <- - runCreateProcess Nothing (Just out) Nothing cp - ih <- runInputHandle inp ev - eh <- runOutputHandle Error err ev - return $ ((ih, eh), phan) - --- | Create a 'Producer' for standard output and a 'Producer' for --- standard error. -pipeOutputError - :: (MonadSafe mo, MonadSafe me, MonadSafe m, MonadCatch (Base m)) - => NonPipe - -- ^ Standard input - -> CreateProcess - -> m ((Producer ByteString mo (), Producer ByteString me ()), ProcessHandle) - -- ^ A 'Producer' for standard output, a 'Producer' for standard - -- error -pipeOutputError inp cp = do - (_, Just out, Just err, ev, phan) <- - runCreateProcess (Just inp) Nothing Nothing cp - oh <- runOutputHandle Output out ev - eh <- runOutputHandle Error err ev - return ((oh, eh), phan) - - --- | Create a 'Consumer' for standard input, a 'Producer' for standard --- output, and a 'Producer' for standard error. -pipeInputOutputError - :: ( MonadSafe mi, MonadSafe mo, MonadSafe me, - MonadSafe m, MonadCatch (Base m)) - => CreateProcess - -> m (( Consumer ByteString mi () - , Producer ByteString mo () - , Producer ByteString me ()), ProcessHandle) - -- ^ A 'Consumer' for standard input, a 'Producer' for standard - -- output, a 'Producer' for standard error -pipeInputOutputError cp = do - (Just inp, Just out, Just err, ev, phan) <- - runCreateProcess Nothing Nothing Nothing cp - ih <- runInputHandle inp ev - oh <- runOutputHandle Output out ev - eh <- runOutputHandle Error err ev - return $ ((ih, oh, eh), phan) +{-# LANGUAGE FlexibleContexts, RankNTypes #-} + +-- | This contains the innards of Cliff. +-- You shouldn't need anything that's in this module; instead, use +-- "Pipes.Cliff". +-- +-- Exit code and waiting for processes: as of base 4.7, there was a +-- bug in 'System.Process.waitForProcess' which may arise if you have +-- multiple threads waiting for a single process to finish. Thus this +-- module is set up so that only one thread does the wait, and it +-- places the result in an MVar. See +-- +-- http://ghc.haskell.org/trac/ghc/ticket/9292 + +module Pipes.Cliff.Core where + +import System.Environment +import Data.List (intersperse) +import Control.Exception (IOException) +import System.IO +import qualified System.Process as Process +import Pipes +import Pipes.Safe +import qualified Data.ByteString as BS +import Data.ByteString (ByteString) +import Control.Concurrent (forkIO) +import Control.Concurrent.Async +import Control.Concurrent.MVar +import System.Exit +import qualified Control.Exception +import Control.Monad +import Control.Concurrent.STM + +-- * Data types + +-- | Like 'Process.CmdSpec' in "System.Process", but also has an +-- instance for 'Show'. +data CmdSpec + = ShellCommand String + | RawCommand FilePath [String] + deriving (Eq, Ord, Show) + +convertCmdSpec :: CmdSpec -> Process.CmdSpec +convertCmdSpec (ShellCommand s) = Process.ShellCommand s +convertCmdSpec (RawCommand p ss) = Process.RawCommand p ss + +-- ** Errors + +-- | When dealing with a 'Handle', errors can occur when reading from, +-- writing to, or closing the handle. +data Activity + = Reading + | Writing + | Closing + deriving (Eq, Ord, Show) + +-- | The two kinds of outbound handles. +data Outbound + = Output + | Error + deriving (Eq, Ord, Show) + +-- | Describes a handle. From the perspective of the subprocess; for +-- example, 'Input' means that this handle is connected to the +-- process's standard input. + +data HandleDesc + = Input + | Outbound Outbound + deriving (Eq, Ord, Show) + +-- | Describes all IO exceptions. The 'Oopsie' contains the +-- 'IOException' itself, along with the 'CmdSpec' that was running +-- when the exception occurred. +-- +-- The exceptions that are caught and placed into an 'Oopsie' may +-- arise from reading data from or writing data to a 'Handle'. In +-- these errors, the associated 'Producer' or 'Consumer' will +-- terminate (which may trigger various cleanup actions in the +-- 'MonadSafe' computation) but the exception itself is not +-- re-thrown; rather, it is passed to the 'handler'. Similarly, an +-- exception may occur while closing a handle; these exceptions are +-- caught, not rethrown, and are passed to the 'handler'. If an +-- exception arises when terminating a process (I'm not sure this is +-- possible) then it is also caught, not rethrown, and passed to the +-- 'handler'. +-- +-- If an exception arises when creating a process--such as a command +-- not being found--the exception is /not/ caught, handled, or +-- passed to the 'handler'. In addition, no exceptions are caught +-- if they originated during a 'Process.waitForProcess'. (I can't +-- conceive of how any synchronous exceptions could arise from +-- 'Process.waitForProcess', but if they do, Cliff does not handle +-- them.) Also, an 'Oopsie' is created only for an 'IOException'; +-- no other exceptions of any kind are caught or handled. However, +-- exceptions of any kind will still trigger appropriate cleanup +-- actions in the 'MonadSafe' computation. +data Oopsie = Oopsie Activity HandleDesc CmdSpec IOException + deriving (Eq, Show) + +-- | Formats an 'Oopsie' for display. +renderOopsie + :: String + -- ^ The name of the currently runnning program + -> Oopsie + -> String +renderOopsie pn (Oopsie act desc cmd ioe) = + pn ++ ": warning: when running command " + ++ renderCommand cmd ++ ": " ++ renderHan + ++ ": " ++ show ioe + where + renderCommand (ShellCommand str) = show str + renderCommand (RawCommand fp ss) + = concat . intersperse " " . map show + $ fp : ss + + renderHan = + "when " ++ actStr ++ " " ++ descStr + where + actStr = case act of + Reading -> "reading from" + Writing -> "writing to" + Closing -> "closing the handle associated with" + descStr = "standard " ++ case desc of + Input -> "input" + Outbound Output -> "output" + Outbound Error -> "error" + +-- | The default handler when receiving an 'Oopsie'; simply uses +-- 'renderOopsie' to format it nicely and put it on standard error. +-- +-- Side effects: gets the program name from the environment, and +-- prints the Oopsie to standard error. +defaultHandler :: Oopsie -> IO () +defaultHandler oops = do + pn <- getProgName + hPutStrLn stderr $ renderOopsie pn oops + +-- ** Configuration types + +-- | How will the subprocess get its information for this stream? A +-- 'NonPipe' is used for streams that will not be assigned to a +-- 'Proxy' but, instead, will be inherited from the parent or directed +-- from an existing 'Handle'. +data NonPipe + = Inherit + -- ^ Use whatever stream that the parent process has. + | UseHandle Handle + -- ^ Use the given handle for input or output + +convertNonPipe :: Maybe NonPipe -> Process.StdStream +convertNonPipe a = case a of + Nothing -> Process.CreatePipe + Just Inherit -> Process.Inherit + Just (UseHandle h) -> Process.UseHandle h + +-- | Like 'System.Process.CreateProcess' in "System.Process", +-- this gives the necessary information to create a subprocess. All +-- but one of these fields is also present in +-- 'System.Process.CreateProcess', and they all have the same meaning; +-- the only field that is different is the 'handler' field. +data CreateProcess = CreateProcess + { cmdspec :: CmdSpec + -- ^ Executable and arguments, or shell command + + , cwd :: Maybe FilePath + -- ^ A new current working directory for the subprocess; if + -- 'Nothing', use the calling process's working directory. + + , env :: Maybe [(String, String)] + -- ^ The environment for the subprocess; if 'Nothing', use the + -- calling process's working directory. + + , close_fds :: Bool + -- ^ If 'True', close all file descriptors other than the standard + -- descriptors. See the documentation for + -- 'System.Process.close_fds' for details on how this works in + -- Windows. + + , create_group :: Bool + -- ^ If 'True', create a new process group. + + , delegate_ctlc :: Bool + -- ^ See 'System.Process.delegate_ctlc' in the "System.Process" + -- module for details. + + , handler :: Oopsie -> IO () + -- ^ Whenever an IO exception arises during the course of various + -- IO actios, the exception is caught and placed into an 'Oopsie' + -- that indicates why and where the exception happened. The + -- 'handler' determines what happens when an 'Oopsie' comes in. + -- See 'Oopsie' for details. + -- + -- The default 'handler' created by 'procSpec' is + -- 'defaultHandler', which will simply print the exceptions to + -- standard error. You may not want to see the exceptions at all. + -- For example, many exceptions come from broken pipes. A broken + -- pipe might be entirely normal in your circumstance. For + -- example, if you are streaming a large set of values to a pager + -- such as @less@ and you expect that the user will often quit the + -- pager without viewing the whole result, a broken pipe will + -- result, which will print a warning message. That can be a + -- nuisance. + -- + -- If you don't want to see the exceptions at all, just set + -- 'handler' to 'squelch', which simply discards the exceptions. + -- + -- Conceivably you could rig up an elaborate mechanism that puts + -- the 'Oopsie's into a "Pipes.Concurrent" mailbox or something. + -- Indeed, when using 'defaultHandler' each thread will print its + -- warnings to standard error at any time. If you are using + -- multiple processes and each prints warnings at the same time, + -- total gibberish can result as the text gets mixed in. You + -- could solve this by putting the errors into a + -- "Pipes.Concurrent" mailbox and having a single thread print the + -- errors; this sort of thing could be built into the library but + -- so far I haven't been motivated to do it. + + } + +-- | Do not show or do anything with exceptions; useful to use as a +-- 'handler'. +-- +-- Side effects: None. +squelch :: Monad m => a -> m () +squelch = const (return ()) + +-- | Create a 'CreateProcess' record with default settings. The +-- default settings are: +-- +-- * a raw command (as opposed to a shell command) is created +-- +-- * the current working directory is not changed from the parent process +-- +-- * the environment is not changed from the parent process +-- +-- * the parent's file descriptors (other than standard input, +-- standard output, and standard error) are inherited +-- +-- * no new process group is created +-- +-- * 'delegate_ctlc' is 'False' +-- +-- * 'handler' is 'defaultHandler' + +procSpec + :: String + -- ^ The name of the program to run, such as @less@. + -> [String] + -- ^ Command-line arguments + -> CreateProcess +procSpec prog args = CreateProcess + { cmdspec = RawCommand prog args + , cwd = Nothing + , env = Nothing + , close_fds = False + , create_group = False + , delegate_ctlc = False + , handler = defaultHandler + } + +convertCreateProcess + :: Maybe NonPipe + -> Maybe NonPipe + -> Maybe NonPipe + -> CreateProcess + -> Process.CreateProcess +convertCreateProcess inp out err a = Process.CreateProcess + { Process.cmdspec = convertCmdSpec $ cmdspec a + , Process.cwd = cwd a + , Process.env = env a + , Process.std_in = conv inp + , Process.std_out = conv out + , Process.std_err = conv err + , Process.close_fds = close_fds a + , Process.create_group = create_group a + , Process.delegate_ctlc = delegate_ctlc a + } + where + conv = convertNonPipe + +-- * MVar types + +-- ** Lock + +-- | Guarantees single-thread access +-- +-- All MVar idioms thanks to Neil Mitchell: +-- +type Lock = MVar () + +newLock :: IO Lock +newLock = newMVar () + +withLock :: Lock -> IO a -> IO a +withLock x = withMVar x . const + +-- ** Var + +-- | Operates on mutable variables in thread-safe way. + +type Var a = MVar a + +newVar :: a -> IO (Var a) +newVar = newMVar + +modifyVar :: Var a -> (a -> IO (a, b)) -> IO b +modifyVar = modifyMVar + +modifyVar_ :: Var a -> (a -> IO a) -> IO () +modifyVar_ = modifyMVar_ + +readVar :: Var a -> IO a +readVar = readMVar + +-- ** Barrier + +-- | Starts with no value, is written to once, and is read one or +-- more times. +type Barrier a = MVar a + +newBarrier :: IO (Barrier a) +newBarrier = newEmptyMVar + +signalBarrier :: Barrier a -> a -> IO () +signalBarrier = putMVar + +waitBarrier :: Barrier a -> IO a +waitBarrier = readMVar + +-- ** MVar abstractions + + +-- | Takes an action and returns a new action. If the action is +-- never called the argument action will never be executed, but if +-- it is called more than once, it will only be executed once. +-- +-- Side effects: creates a 'Var'. Returns an IO action that modifies +-- the contents of that 'Var'. +once :: IO a -> IO (IO a) +once act = do + var <- newVar Nothing + return $ join $ modifyVar var $ \v -> case v of + Nothing -> do + b <- newBarrier + let r = do + x <- act + signalBarrier b x + return x + return (Just b, r) + Just b -> return (Just b, waitBarrier b) + +-- * Mailboxes + +-- | Creates a new mailbox. Returns an action to send to the mailbox; +-- this action will return False if the mailbox is sealed, or True if +-- the message was successfully placed in the mailbox. Also returns +-- an action to retrieve from the mailbox, which returns Nothing if +-- the mailbox is sealed, or Just if there is a value to be retrieved. +-- Also returns an action to seal the mailbox. +messageBox :: IO (a -> STM Bool, STM (Maybe a), STM ()) +messageBox = atomically $ do + locked <- newTVar False + mailbox <- newEmptyTMVar + return (sendBox locked mailbox, recvBox locked mailbox, sealer locked) + +sendBox :: TVar Bool -> TMVar a -> a -> STM Bool +sendBox locked mailbox a = do + isLocked <- readTVar locked + if isLocked + then return False + else do + putTMVar mailbox a + return True + +recvBox :: TVar Bool -> TMVar a -> STM (Maybe a) +recvBox locked mailbox = do + mayA <- tryTakeTMVar mailbox + case mayA of + Just a -> return $ Just a + Nothing -> do + isLocked <- readTVar locked + if isLocked + then return Nothing + else retry + +sealer :: TVar Bool -> STM () +sealer locked = writeTVar locked True + +produceFromBox :: MonadIO m => STM (Maybe a) -> Producer a m () +produceFromBox stm = do + mayV <- liftIO $ atomically stm + case mayV of + Nothing -> return () + Just v -> yield v >> produceFromBox stm + +sendToBox :: MonadIO m => (a -> STM Bool) -> Consumer a m () +sendToBox stm = do + v <- await + r <- liftIO $ atomically (stm v) + if r then sendToBox stm else return () + +-- * Console + +-- | Data that is computed once, after the process has been created. +-- After computation, this data does not change. +data Console = Console + { csIn :: Maybe Handle + -- ^ Standard input + , csOut :: Maybe Handle + -- ^ Standard output + , csErr :: Maybe Handle + -- ^ Standard error + , csHandle :: Process.ProcessHandle + , csExitCode :: IO ExitCode + -- ^ IO action that will return the exit code. Use this rather than + -- using 'Process.waitForProcess' on the 'csHandle'. + , csLock :: Lock + -- ^ If locked, new resources cannot be created. Obtain this lock + -- while registering new releasers in 'csReleasers'. + , csReleasers :: Var [IO ()] + -- ^ Each time a resource is created, register a finalizer here. + -- These finalizers are run when 'terminateProcess' is run. + } + + +-- | Is this process still running? +-- +-- Side effects: examines the process handle to see if it has yet +-- returned a value. Does not block; should return immediately. +isStillRunning :: ProcessHandle -> IO Bool +isStillRunning ph = do + cnsl <- phConsole ph + cd <- Process.getProcessExitCode (csHandle cnsl) + return . maybe True (const False) $ cd + +-- | Allows you to terminate the process, as well as to obtain some +-- information about the process. +data ProcessHandle = ProcessHandle + { phCreateProcess :: CreateProcess + , phConsole :: IO Console + } + +-- | Tells you the 'CreateProcess' that was originally used to create +-- the process associated with this 'ProcessHandle'. +originalCreateProcess :: ProcessHandle -> CreateProcess +originalCreateProcess = phCreateProcess + +-- | Add a finalizer to the ProcessHandle. When the finalizers are run, all +-- exceptions are ignored, except asynchronous exceptions, which are +-- masked. +addReleaser :: ProcessHandle -> IO () -> IO () +addReleaser pnl rel = do + cnsl <- phConsole pnl + withLock (csLock cnsl) $ + modifyVar_ (csReleasers cnsl) (\ls -> return (rel : ls)) + +-- | Terminates a process. Cleans up all associated resources. Use +-- this with 'Control.Exception.bracket' to ensure proper cleanup of +-- resources. +terminateProcess :: ProcessHandle -> IO () +terminateProcess pnl = mask_ $ do + cnsl <- phConsole pnl + withLock (csLock cnsl) $ do + let runFnlzr fnl = fnl `catch` catcher + catcher e = return () + where _types = e :: Control.Exception.SomeException + fnlzrs <- readVar (csReleasers cnsl) + mapM_ runFnlzr fnlzrs + +-- | Gets the exit code of the process that belongs to the 'ProcessHandle'. +-- Side effects: may block if process has not yet exited. Usually you +-- can get the exit code through more idiomatic @pipes@ functions, as +-- the various 'Proxy' return the 'ExitCode'. +waitForProcess :: ProcessHandle -> IO ExitCode +waitForProcess pnl = phConsole pnl >>= csExitCode + +-- | Creates a new ProcessHandle. +-- +-- Side effects: Does not create the process right away; +-- instead, creates an IO action that, when run, will create the +-- process. This IO action contains another IO action that, when run, +-- will return the process exit code. +-- +-- In addition, the IO action will fork a simple thread that will +-- immediately wait for the process. In effect, this means there is +-- immediately a thread that will wait for the process to exit. +-- Because this IO action was created with 'once', that means only +-- one thread ever does the @wait@, which avoids a bug in +-- "System.Process". +newProcessHandle + :: Maybe NonPipe + -> Maybe NonPipe + -> Maybe NonPipe + -> CreateProcess + -> IO ProcessHandle +newProcessHandle inp out err cp = liftM2 ProcessHandle (return cp) (once act) + where + act = mask_ $ do + (inp', out', err', han) <- Process.createProcess + (convertCreateProcess inp out err cp) + let killHan mayH desc = case mayH of + Nothing -> return () + Just h -> closeHandleNoThrow h desc (cmdspec cp) (handler cp) + destroyers = + [ killHan inp' Input, killHan out' (Outbound Output), + killHan err' (Outbound Error), + Process.terminateProcess han ] + getCode <- once $ Process.waitForProcess han + _ <- forkIO (getCode >> return ()) + lock <- newLock + rlsrs <- newVar destroyers + return $ Console inp' out' err' han getCode lock rlsrs + + +-- * Exception handling + +-- | Sends an exception using the exception handler specified in the +-- 'ErrSpec'. Side effects: transmits the 'Oopsie' to the right +-- place; the recipient of the 'Oopsie' might have additional side +-- effects. +handleException + :: Activity + -> HandleDesc + -> CmdSpec + -> (Oopsie -> IO ()) + -> IOException + -> IO () +handleException act desc spec sender exc = sender oops + where + oops = Oopsie act desc spec exc + +-- | Close a handle. Catches any exceptions and passes them to the handler. +closeHandleNoThrow + :: Handle + -> HandleDesc + -> CmdSpec + -> (Oopsie -> IO ()) + -> IO () +closeHandleNoThrow hand desc spec hndlr + = (hClose hand) `catch` + (handleException Closing desc spec hndlr) + + +-- * Threads + +-- | Runs in the background an effect, typically one that is moving +-- data from one process to another. For examples of its usage, see +-- "Pipes.Cliff.Examples". +conveyor :: Effect (SafeT IO) a -> IO (Async a) +conveyor = async . runSafeT . runEffect + +-- * Effects + +-- | Runs in the foreground an effect in the 'SafeT' monad. +safeEffect :: Effect (SafeT IO) a -> IO a +safeEffect = runSafeT . runEffect + + +-- * Mailboxes + +-- | Creates a new mailbox and returns 'Proxy' that stream values +-- into and out of the mailbox. Each 'Proxy' is equipped with a +-- finalizer that will seal the mailbox immediately after production +-- or consumption has completed, even if such completion is not due +-- to an exhausted mailbox. This will signal to the other side of +-- the mailbox that the mailbox is sealed. +-- +-- In addition to returning the two 'Proxy', also returns an STM +-- action that will manually seal the mailbox. +newMailbox + :: (MonadSafe mi, MonadSafe mo) + => IO (Consumer a mi (), Producer a mo (), STM ()) +newMailbox = do + (toBox, fromBox, seal) <- messageBox + let csmr = register (liftIO $ atomically seal) + >> sendToBox toBox + pdcr = register (liftIO $ atomically seal) + >> produceFromBox fromBox + return (csmr, pdcr, seal) + +-- * Type synonyms + +-- | Consumer that reads values for a process standard input. Its +-- input value is described in 'Outstream'. The result type is a +-- tuple @(a, b)@, where @a@ is the return code from the upstream +-- process, and @b@ is the return code from this process. @a@ will be +-- Nothing if the downstream process terminated before the upstream +-- one, or @Just@ if the upstream process terminated first. The +-- 'Consumer' process's process exit code is always available and is +-- returned in @b@. +type Stdin m a + = Consumer (Either a ByteString) m (Maybe a, ExitCode) + +-- | Producer of values from a process standard output or error. 'yield' a +-- @'Left'@ if the stream is done producing values, or a +-- @'Right' 'ByteString'@ if the stream is still producing values. +-- 'Outstream' is polymorphic in its return type, @r@, becasuse the +-- 'Outstream' never stops yielding values; instead, it just 'yield's +-- its exit code over and over again after the process terminates. + +type Outstream r m a + = Producer (Either a ByteString) m r + +-- | Producer of values from a process standard output. +type Stdout r m a = Outstream r m a + +-- | Producer of values from a process standard error. +type Stderr r m a = Outstream r m a + + +-- * 'Proxy' combinators + +-- | Forwards only Right values; terminates on the first Left value +-- and returns its value. Useful to forward the output of an +-- 'Outstream' to a pipeline that expects only 'ByteString's. +forwardRight :: Monad m => Pipe (Either a b) b m a +forwardRight = do + ei <- await + case ei of + Left l -> return l + Right r -> yield r >> forwardRight + +-- | Forwards all values, after rewrapping them in a Right. Useful to +-- convert a producer of 'ByteString' into a 'Producer' of 'Either' +-- which can be fed to a 'Stdin'. +wrapRight :: Monad m => Pipe a (Either l a) m r +wrapRight = do + x <- await + yield (Right x) + wrapRight + +-- | Converts a 'Producer' that returns a particular type +-- to one that never returns a value at all but that, instead, takes +-- that return type and 'yield's it forever as a 'Left'. Use it with +-- '>>=', like so: +-- +-- @ +-- alwaysUnit :: Monad m => Producer (Either () a) m r +-- alwaysUnit = return () >>= immortal +-- @ +-- +-- This is useful to convert a producer of values that might terminate +-- into one that does not terminate, so that it can be fed into a +-- 'Stdin'. For an example of its use, see +-- 'Penny.Cliff.Examples.limitedAlphaNumbers'. +immortal :: Monad m => r -> Producer' (Either r a) m r' +immortal a = forever (yield (Left a)) + +-- * Exception safety + +-- | Creates a process, uses it, and terminates it when the last +-- computation ends. Don't try to use any of the process resources +-- after the last computation ends, because the process will already +-- have been terminated. For an example of its use, see +-- 'Pipes.Cliff.Examples.standardOutputAndErrorBracketed'. +withProcess + :: IO (a, ProcessHandle) + -- ^ Creates the process + -> (a -> IO b) + -- ^ Uses the process + -> IO b +withProcess acq use = Control.Exception.bracket acq (terminateProcess . snd) + (use . fst) + +-- | Runs an 'Effect' in the backgroud (typically one that is moving +-- data from one process to another). If the background thread is +-- still running when the second computation ends, the background +-- thread is terminated. For an example of its use, see +-- 'Pipes.Cliff.Examples.standardOutputAndErrorBracketed'. + +withConveyor + :: Effect (SafeT IO) a + -- ^ The 'Effect' to run in another thread + -> IO b + -- ^ The rest of the computation to run + -> IO b +withConveyor cvy end = Control.Exception.bracket (conveyor cvy) cancel + (\_ -> end) + +-- * Production from and consumption to 'Handle's + +-- | I have no idea what this should be. I'll start with a simple +-- small value and see how it works. +bufSize :: Int +bufSize = 1024 + + +-- | Initialize a handle. Returns a computation in the MonadSafe +-- monad. That computation has a registered finalizer that will close +-- a particular handle that is found in the 'ProcessHandle'. As a side +-- effect, the IO action creating the 'ProcessHandle' is viewed, meaning that +-- the process will launch if it hasn't already done so. +initHandle + :: (MonadSafe mi, MonadCatch (Base mi)) + => HandleDesc + -- ^ Used for error messages + -> (Console -> Handle) + -- ^ Fetch the handle to close from the 'ProcessHandle'. + -> ProcessHandle + -- ^ Has the 'Handle' that will be closed. + -> (Handle -> mi a) + -- ^ The remainder of the computation. + -> IO (mi a) +initHandle desc get pnl mkProxy = mask_ $ do + cnsl <- phConsole $ pnl + return $ mask $ \restore -> + let han = get cnsl + fnlzr = closeHandleNoThrow han desc (cmdspec . phCreateProcess $ pnl) + (handler . phCreateProcess $ pnl) + in register (liftIO fnlzr) >> (restore $ mkProxy han) + +-- Returns a Consumer for process standard input. +-- +-- Side effects: Process is started if it isn't already. The returned +-- computation will await values and pass them on to the process +-- standard input mailbox. Any IO exceptions are caught, and +-- consumption terminates. +-- +-- I would rather just catch broken pipe exceptions, but I'm not sure +-- there is a good way to do that. +consumeToHandle + :: (MonadSafe mi, MonadCatch (Base mi)) + => ProcessHandle + -> IO (Consumer ByteString mi ()) +consumeToHandle pnl = initHandle Input get pnl fn + where + get cnsl = case csIn cnsl of + Just h -> h + Nothing -> error "consumeToHandle: handle not initialized" + fn han = do + let hndlr = liftIO . handleException Writing Input + (cmdspec . phCreateProcess $ pnl) + (handler . phCreateProcess $ pnl) + go = do + bs <- await + liftIO $ BS.hPut han bs + go + go `catch` hndlr + +-- | Produce values from a process standard output. Process is +-- started if it isn't already. +produceFromHandle + :: (MonadSafe mi, MonadCatch (Base mi)) + => Outbound + -> ProcessHandle + -> IO (Producer ByteString mi ()) +produceFromHandle outb pnl = initHandle (Outbound outb) get pnl fn + where + get cnsl = case outb of + Output -> case csOut cnsl of + Nothing -> error "produceFromHandle: stdout not initialized" + Just h -> h + Error -> case csErr cnsl of + Nothing -> error "produceFromHandle: stderr not initialized" + Just h -> h + fn han = + let hndlr = liftIO . handleException Reading (Outbound outb) + (cmdspec . phCreateProcess $ pnl) + (handler . phCreateProcess $ pnl) + go bs + | BS.null bs = return () + | otherwise = yield bs >> produce + produce = liftIO (BS.hGetSome han bufSize) >>= go + in produce `catch` hndlr + + +-- | Given an 'Async', waits for that thread to finish processing +-- values. When it completes, wait for the process exit code. +finishProxy + :: Async () + -> ProcessHandle + -> IO ExitCode +finishProxy thread pnl = do + _ <- wait thread + waitForProcess pnl + +-- | Takes all steps necessary to get a 'Consumer' for standard +-- input: +-- +-- * Creates a 'Consumer' that will consume to the process standard +-- input. This 'Consumer' registers a MonadSafe releaser that will +-- close the handle. +-- +-- * Creates a mailbox, with a 'Producer' from the mailbox and a +-- 'Consumer' to the mailbox. Each of these 'Proxy' has a MonadSafe +-- releaser that will close the mailbox. +-- +-- * Spwans a thread to run an 'Effect' that connects the 'Consumer' +-- that is connected to the handle to the 'Producer' from the mailbox. +-- In a typical UNIX pipeline situation (where the process keeps its +-- stdin open as long as it is getting input) this 'Effect' will stop +-- running only when the mailbox is sealed. +-- +-- * Registers a releaser in the Panel (not in the MonadSafe +-- computation) to destroy the thread; this is in case the user +-- terminates the process. +-- +-- * Returns a 'Consumer'. The 'Consumer' consumes to the mailbox. +-- The 'Consumer' forwards all 'Right' values obtained from the +-- 'yield' to the mailbox. The 'Consumer' ceases consumption on the +-- first 'Left' value. +-- +-- The returned 'Consumer' will, on the first 'Left' value, manually +-- seal the mailbox that transmits to the spawned thread. This causes +-- the background 'Effect' to shut down which will, in turn, cause the +-- 'MonadSafe' computation to invoke its finalizers which will close +-- the process's stdin. That should cause the process to shut down. +-- Then we wait for the background thead to finish, and then wait for +-- the process's exit code. +-- +-- The returned 'Proxy' always returns the exit code of this process. +-- In addition, if the upstream 'Producer' terminated first, that +-- return value is returned as well. If this process terminated first +-- (perhaps because the user shut it down manually, or it otherwise +-- shut down without needing all of its stdin) then there will be no +-- return value from the upstream 'Producer' to return. +runInputHandle + :: (MonadSafe mi, MonadCatch (Base mi)) + => ProcessHandle + -- ^ + -> IO (Stdin mi r) + -- ^ +runInputHandle pnl = mask_ $ do + csmr <- consumeToHandle pnl + (toBox, fromBox, seal) <- newMailbox + asyncId <- conveyor $ fromBox >-> csmr + addReleaser pnl (cancel asyncId) + let f proxyRes = do + liftIO . atomically $ seal + thisCode <- liftIO $ finishProxy asyncId pnl + return $ case proxyRes of + Just firstCode -> (Just firstCode, thisCode) + Nothing -> (Nothing, thisCode) + + return (((fmap Just forwardRight) >-> fmap (const Nothing) toBox) >>= f) + + +-- | Takes all steps necessary to get a 'Producer' for standard +-- input. Sets up a mailbox, runs a conveyor in the background. Then +-- receives streaming data, and then gets the process exit code. +runOutputHandle + :: (MonadSafe mi, MonadCatch (Base mi)) + => Outbound + -- ^ + -> ProcessHandle + -- ^ + -> IO (Outstream r mi ExitCode) + -- ^ +runOutputHandle outb pnl = mask_ $ do + pdcFromHan <- produceFromHandle outb pnl + (toBox, fromBox, _) <- newMailbox + asyncId <- conveyor $ pdcFromHan >-> toBox + addReleaser pnl (cancel asyncId) + let f () = do + code <- liftIO $ finishProxy asyncId pnl + forever (yield (Left code)) + return $ (fromBox >-> wrapRight) >>= f + + +-- * Creating Proxy + +-- | Create a 'Consumer' for standard input. +pipeInput + :: (MonadSafe m, MonadCatch (Base m)) + + => NonPipe + -- ^ Standard output + + -> NonPipe + -- ^ Standard error + + -> CreateProcess + + -> IO (Stdin m a, ProcessHandle) + -- ^ A 'Consumer' for standard input +pipeInput out err cp = mask_ $ do + pnl <- newProcessHandle Nothing (Just out) (Just err) cp + inp <- runInputHandle pnl + return (inp, pnl) + + +-- | Create a 'Producer' for standard output. +pipeOutput + :: (MonadSafe mo, MonadCatch (Base mo)) + + => NonPipe + -- ^ Standard input + + -> NonPipe + -- ^ Standard error + + -> CreateProcess + + -> IO (Stdout r mo ExitCode, ProcessHandle) + -- ^ A 'Producer' for standard output +pipeOutput inp err cp = mask_ $ do + pnl <- newProcessHandle (Just inp) Nothing (Just err) cp + pdcr <- runOutputHandle Output pnl + return (pdcr, pnl) + + +-- | Create a 'Producer' for standard error. +pipeError + :: (MonadSafe me, MonadCatch (Base me)) + + => NonPipe + -- ^ Standard input + + -> NonPipe + -- ^ Standard output + + -> CreateProcess + + -> IO (Stderr r me ExitCode, ProcessHandle) + -- ^ A 'Producer' for standard error + +pipeError inp out cp = mask_ $ do + pnl <- newProcessHandle (Just inp) (Just out) Nothing cp + pdcr <- runOutputHandle Error pnl + return (pdcr, pnl) + +-- | Create a 'Consumer' for standard input and a 'Producer' for +-- standard output. +pipeInputOutput + :: ( MonadSafe mi, MonadCatch (Base mi), + MonadSafe mo, MonadCatch (Base mo)) + + => NonPipe + -- ^ Standard error + + -> CreateProcess + + -> IO ((Stdin mi a, Stdout r mo ExitCode), ProcessHandle) + -- ^ A 'Consumer' for standard input, a 'Producer' for standard + -- output + +pipeInputOutput err cp = mask_ $ do + pnl <- newProcessHandle Nothing Nothing (Just err) cp + csmr <- runInputHandle pnl + pdcr <- runOutputHandle Output pnl + return ((csmr, pdcr), pnl) + +-- | Create a 'Consumer' for standard input and a 'Producer' for +-- standard error. +pipeInputError + :: ( MonadSafe mi, MonadCatch (Base mi), + MonadSafe me, MonadCatch (Base me)) + + => NonPipe + + -- ^ Standard output + -> CreateProcess + + -> IO ((Stdin mi a, Stderr r me ExitCode), ProcessHandle) + -- ^ A 'Consumer' for standard input, a 'Producer' for standard + -- error +pipeInputError out cp = do + pnl <- newProcessHandle Nothing (Just out) Nothing cp + csmr <- runInputHandle pnl + pdcr <- runOutputHandle Error pnl + return ((csmr, pdcr), pnl) + + +-- | Create a 'Producer' for standard output and a 'Producer' for +-- standard error. +pipeOutputError + :: ( MonadSafe mo, MonadCatch (Base mo), + MonadSafe me, MonadCatch (Base me)) + + => NonPipe + -- ^ Standard input + + -> CreateProcess + + -> IO ((Stdout ro mo ExitCode, Stderr re me ExitCode), ProcessHandle) + -- ^ A 'Producer' for standard output and a 'Producer' for standard + -- error + +pipeOutputError inp cp = do + pnl <- newProcessHandle (Just inp) Nothing Nothing cp + pdcrOut <- runOutputHandle Output pnl + pdcrErr <- runOutputHandle Error pnl + return ((pdcrOut, pdcrErr), pnl) + + +-- | Create a 'Consumer' for standard input, a 'Producer' for standard +-- output, and a 'Producer' for standard error. +pipeInputOutputError + :: ( MonadSafe mi, MonadCatch (Base mi), + MonadSafe mo, MonadCatch (Base mo), + MonadSafe me, MonadCatch (Base me)) + + => CreateProcess + + -> IO ( (Stdin mi a, Stdout ro mo ExitCode, Stderr re me ExitCode) + , ProcessHandle + ) + -- ^ A 'Consumer' for standard input, a 'Producer' for standard + -- output, and a 'Producer' for standard error + +pipeInputOutputError cp = do + pnl <- newProcessHandle Nothing Nothing Nothing cp + csmr <- runInputHandle pnl + pdcrOut <- runOutputHandle Output pnl + pdcrErr <- runOutputHandle Error pnl + return ((csmr, pdcrOut, pdcrErr), pnl) diff --git a/lib/Pipes/Cliff/Examples.hs b/lib/Pipes/Cliff/Examples.hs --- a/lib/Pipes/Cliff/Examples.hs +++ b/lib/Pipes/Cliff/Examples.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RankNTypes #-} -- | Examples using "Pipes.Cliff". You will want to look at the -- source code itself; viewing just the Haddocks will not help you -- much. You can view the source using Haddock if you used @@ -11,11 +12,11 @@ -- that uses "Pipes.Cliff", including this code; see the warning in -- "Pipes.Cliff" for more details. -- --- Notice throughout how pipelines that move data from one process --- to another typically are run in the background using 'conveyor', --- and that threads that produce information you need to use are run --- in the 'background' so you can use 'waitForThread' to retrieve --- their results. +-- Notice throughout how pipelines that move data from one process to +-- another typically are run in the background using 'conveyor', which +-- spawns a thread. You have to make sure all these threads are +-- running concurrently so that data flows through your pipeline (a +-- shell does this sort of thing for you.) module Pipes.Cliff.Examples where @@ -23,6 +24,19 @@ import qualified Pipes.Prelude as P import qualified Data.ByteString.Char8 as BS8 + +-- | Produces a stream of 'BS8.ByteString', where each +-- 'BS8.ByteString' is a shown integer. This is an infinite stream. +-- In the examples below we'll send this infinite stream off into a +-- Unix pipeline, a feat that would be very difficult and clumsy +-- without a framework like @pipes@. + +produceNumbers :: Monad m => Producer BS8.ByteString m r +produceNumbers = go (0 :: Int) + where + go i = yield ((BS8.pack . show $ i) `BS8.snoc` '\n') + >> go (succ i) + -- | Streams an infinite list of numbers to @less@. -- The 'Effect' that streams values to the process is run in the -- background by using 'conveyor', even though there is only one @@ -33,26 +47,26 @@ -- error. This is normal. To suppress them, see the 'handler' -- option. -numsToLess :: IO ExitCode -numsToLess = runSafeT $ do - (toLess, han) <- pipeInput Inherit Inherit (procSpec "less" []) - conveyor $ produceNumbers >-> toLess - waitForProcess han +numsToLess :: IO (Maybe ExitCode, ExitCode) +numsToLess = do + (toLess, _) <- pipeInput Inherit Inherit (procSpec "less" []) + safeEffect $ produceNumbers >-> wrapRight >-> toLess -- | Streams an infinite list of numbers to @tr@ and then to @less@. -- Perfectly useless, but shows how to build pipelines. Also -- squlches warning messages using the 'handler' option. - -alphaNumbers :: IO ExitCode -alphaNumbers = runSafeT $ do +alphaNumbers :: IO (ExitCode, ExitCode) +alphaNumbers = do ((toTr, fromTr), _) <- pipeInputOutput Inherit (procSpec "tr" ["[0-9]", "[a-z]"]) { handler = squelch } - (toLess, lessHan) <- pipeInput Inherit Inherit - (procSpec "less" []) { handler = squelch } - conveyor $ produceNumbers >-> toTr - conveyor $ fromTr >-> toLess - waitForProcess lessHan + (toLess, _) <- pipeInput Inherit Inherit + (procSpec "less" []) { handler = squelch } + toTrAsync <- conveyor $ produceNumbers >-> wrapRight >-> toTr + toLessAsync <- conveyor $ fromTr >-> toLess + (_, trCode) <- wait toTrAsync + (_, lessCode) <- wait toLessAsync + return (trCode, lessCode) -- | Produces an infinite stream of numbers, sends it to @tr@ for some @@ -70,61 +84,80 @@ -- the @sh@ process's standard error will be much longer than the -- output the user actually viewed in @less@. standardOutputAndError :: IO BS8.ByteString -standardOutputAndError = runSafeT $ do +standardOutputAndError = do ((toTr, fromTr), _) <- pipeInputOutput Inherit (procSpec "tr" ["[0-9]", "[a-z]"]) ((toSh, fromShOut, fromShErr), _) <- pipeInputOutputError (procSpec "sh" ["-c", script]) - (toLess, lessHan) <- pipeInput Inherit Inherit (procSpec "less" []) - conveyor $ produceNumbers >-> toTr - conveyor $ fromTr >-> toSh - conveyor $ fromShOut >-> toLess - foldHan <- - background - . runSafeT - $ P.fold BS8.append BS8.empty id fromShErr - _ <- waitForProcess lessHan - waitForThread foldHan + (toLess, _) <- pipeInput Inherit Inherit (procSpec "less" []) + _ <- conveyor $ produceNumbers >-> wrapRight >-> toTr + _ <- conveyor $ fromTr >-> toSh + _ <- conveyor $ fromShOut >-> toLess + runSafeT + $ P.fold BS8.append BS8.empty id + (fromShErr >-> (forwardRight >> return ())) where script = "while read line; do echo $line; echo $line 1>&2; done" + -- | Like 'alphaNumbers' but just sends a limited number -- of numbers to @cat@. A useful test to make sure that pipelines --- shut down automatically. Runs both pipelines in the background and --- uses 'waitForProcess' to wait until @cat@ is done. -limitedAlphaNumbers :: IO ExitCode -limitedAlphaNumbers = runSafeT $ do +-- shut down automatically. +limitedAlphaNumbers :: IO (Maybe ExitCode, ExitCode) +limitedAlphaNumbers = do ((toTr, fromTr), _) <- pipeInputOutput Inherit (procSpec "tr" ["[0-9]", "[a-z]"]) - (toCat, catHan) <- pipeInput Inherit Inherit - (procSpec "cat" []) - conveyor $ produceNumbers >-> P.take 300 >-> toTr - conveyor $ fromTr >-> toCat - waitForProcess catHan + (toCat, _) <- pipeInput Inherit Inherit (procSpec "cat" []) + _ <- async + . safeEffect + $ produceNumbers + >-> wrapRight + >-> (P.take 300 >>= immortal) + >-> toTr + safeEffect $ fromTr >-> toCat + -- | Produces a finite list of numbers, sends it to @tr@ for some -- mangling, and then puts the results into a 'BS8.ByteString' for -- further processing. This example shows how you can use this -- library to place the results of a pipeline into a simple strict -- data type. alphaNumbersByteString :: IO BS8.ByteString -alphaNumbersByteString = runSafeT $ do +alphaNumbersByteString = do ((toTr, fromTr), _) <- pipeInputOutput Inherit (procSpec "tr" ["[0-9]", "[a-z]"]) - conveyor $ produceNumbers >-> P.take 300 >-> toTr - threadHan <- - background - . runSafeT - $ P.fold BS8.append BS8.empty id fromTr - waitForThread threadHan - + _ <- conveyor + $ produceNumbers + >-> wrapRight + >-> (P.take 300 >>= immortal) + >-> toTr + let trByteStrings = (fromTr >-> forwardRight) >> return () + runSafeT + $ P.fold BS8.append BS8.empty id trByteStrings --- | Produces a stream of 'BS8.ByteString', where each --- 'BS8.ByteString' is a shown integer. +-- | So far, all examples have ignored the issue of exception safety. +-- Here's an example that properly uses 'bracket' to make sure that +-- all resource allocations are cleaned up if there is an exception. +-- Otherwise, it's identical to 'standardOutputAndError'. You can put +-- some @do@ notation sugar in here and eliminate all the hanging +-- lambdas and '$'s by using the 'ContT' monad from @transformers@ (I +-- did not write the example that way to avoid incurring a direct +-- dependency on @transformers@). -produceNumbers :: Monad m => Producer BS8.ByteString m () -produceNumbers = each . fmap mkNumStr $ [(0 :: Int) ..] - where - mkNumStr = flip BS8.snoc '\n' . BS8.pack . show +standardOutputAndErrorBracketed :: IO BS8.ByteString +standardOutputAndErrorBracketed = + withProcess (pipeInputOutput Inherit (procSpec "tr" ["[0-9]", "[a-z]"])) + $ \(toTr, fromTr) -> + withProcess (pipeInputOutputError (procSpec "sh" ["-c", script])) + $ \(toSh, fromShOut, fromShErr) -> + withProcess (pipeInput Inherit Inherit (procSpec "less" [])) $ \toLess -> + withConveyor (produceNumbers >-> wrapRight >-> toTr) $ + withConveyor (fromTr >-> toSh) $ + withConveyor (fromShOut >-> toLess) $ + runSafeT + $ P.fold BS8.append BS8.empty id + (fromShErr >-> (forwardRight >> return ())) + where + script = "while read line; do echo $line; echo $line 1>&2; done" diff --git a/pipes-cliff.cabal b/pipes-cliff.cabal --- a/pipes-cliff.cabal +++ b/pipes-cliff.cabal @@ -3,12 +3,12 @@ -- http://www.github.com/massysett/cartel -- -- Script name used to generate: genCabal.hs --- Generated on: 2015-03-24 13:45:58.663565 EDT --- Cartel library version: 0.14.2.0 +-- Generated on: 2015-03-29 12:57:28.11669 EDT +-- Cartel library version: 0.14.2.6 name: pipes-cliff -version: 0.6.0.0 -cabal-version: >= 1.16 +version: 0.8.0.0 +cabal-version: >= 1.18 license: BSD3 license-file: LICENSE build-type: Simple @@ -23,8 +23,8 @@ pipes-cliff helps you spawn subprocesses and send data to and from them with the Pipes library. Subprocesses are opened using the - process library, and the processes and handles are properly - cleaned up even if there are exceptions. + process library, and you stream data in and out using the various + Pipes abstractions. . Though this library uses the Pipes library, I have not coordinated with the author of the Pipes library in any way. Any bugs or design @@ -39,6 +39,7 @@ category: Pipes, Concurrency tested-with: GHC == 7.8.2 + GHC == 7.10.1 extra-source-files: README.md @@ -50,13 +51,13 @@ hs-source-dirs: lib build-depends: - base >= 4.6.0.0 && < 4.8 + base >= 4.7.0.0 && < 4.9 , pipes >= 4.1 && < 4.2 , pipes-safe >= 2.2 && < 2.3 , bytestring >= 0.10.4 && < 0.11 , process >= 1.2.0.0 && < 1.3 , async >= 2.0 && < 2.1 - , pipes-concurrency >= 2.0.3 && < 2.1 + , stm >= 2.4.4 && < 2.5 default-language: Haskell2010 ghc-options: -Wall @@ -80,13 +81,13 @@ Pipes.Cliff.Core Pipes.Cliff.Examples build-depends: - base >= 4.6.0.0 && < 4.8 + base >= 4.7.0.0 && < 4.9 , pipes >= 4.1 && < 4.2 , pipes-safe >= 2.2 && < 2.3 , bytestring >= 0.10.4 && < 0.11 , process >= 1.2.0.0 && < 1.3 , async >= 2.0 && < 2.1 - , pipes-concurrency >= 2.0.3 && < 2.1 + , stm >= 2.4.4 && < 2.5 ghc-options: -threaded else @@ -107,13 +108,13 @@ Pipes.Cliff.Core Pipes.Cliff.Examples build-depends: - base >= 4.6.0.0 && < 4.8 + base >= 4.7.0.0 && < 4.9 , pipes >= 4.1 && < 4.2 , pipes-safe >= 2.2 && < 2.3 , bytestring >= 0.10.4 && < 0.11 , process >= 1.2.0.0 && < 1.3 , async >= 2.0 && < 2.1 - , pipes-concurrency >= 2.0.3 && < 2.1 + , stm >= 2.4.4 && < 2.5 ghc-options: -threaded else @@ -134,13 +135,13 @@ Pipes.Cliff.Core Pipes.Cliff.Examples build-depends: - base >= 4.6.0.0 && < 4.8 + base >= 4.7.0.0 && < 4.9 , pipes >= 4.1 && < 4.2 , pipes-safe >= 2.2 && < 2.3 , bytestring >= 0.10.4 && < 0.11 , process >= 1.2.0.0 && < 1.3 , async >= 2.0 && < 2.1 - , pipes-concurrency >= 2.0.3 && < 2.1 + , stm >= 2.4.4 && < 2.5 ghc-options: -threaded else @@ -161,13 +162,13 @@ Pipes.Cliff.Core Pipes.Cliff.Examples build-depends: - base >= 4.6.0.0 && < 4.8 + base >= 4.7.0.0 && < 4.9 , pipes >= 4.1 && < 4.2 , pipes-safe >= 2.2 && < 2.3 , bytestring >= 0.10.4 && < 0.11 , process >= 1.2.0.0 && < 1.3 , async >= 2.0 && < 2.1 - , pipes-concurrency >= 2.0.3 && < 2.1 + , stm >= 2.4.4 && < 2.5 ghc-options: -threaded else @@ -188,13 +189,13 @@ Pipes.Cliff.Core Pipes.Cliff.Examples build-depends: - base >= 4.6.0.0 && < 4.8 + base >= 4.7.0.0 && < 4.9 , pipes >= 4.1 && < 4.2 , pipes-safe >= 2.2 && < 2.3 , bytestring >= 0.10.4 && < 0.11 , process >= 1.2.0.0 && < 1.3 , async >= 2.0 && < 2.1 - , pipes-concurrency >= 2.0.3 && < 2.1 + , stm >= 2.4.4 && < 2.5 ghc-options: -threaded else diff --git a/tests/alphaNumbers.hs b/tests/alphaNumbers.hs --- a/tests/alphaNumbers.hs +++ b/tests/alphaNumbers.hs @@ -1,7 +1,6 @@ module Main where import Pipes.Cliff.Examples -import System.Exit main :: IO () -main = alphaNumbers >>= exitWith +main = alphaNumbers >>= print diff --git a/tests/limitedAlphaNumbers.hs b/tests/limitedAlphaNumbers.hs --- a/tests/limitedAlphaNumbers.hs +++ b/tests/limitedAlphaNumbers.hs @@ -1,7 +1,6 @@ module Main where import Pipes.Cliff.Examples -import System.Exit main :: IO () -main = limitedAlphaNumbers >>= exitWith +main = limitedAlphaNumbers >>= print diff --git a/tests/numsToLess.hs b/tests/numsToLess.hs --- a/tests/numsToLess.hs +++ b/tests/numsToLess.hs @@ -1,7 +1,6 @@ module Main where import Pipes.Cliff.Examples -import System.Exit main :: IO () -main = numsToLess >>= exitWith +main = numsToLess >>= print