typed-process (empty) → 0.1.0.0

raw patch · 8 files changed

+1477/−0 lines, 8 filesdep +asyncdep +basedep +base64-bytestringsetup-changed

Dependencies added: async, base, base64-bytestring, bytestring, conduit, conduit-extra, exceptions, hspec, http-conduit, process, stm, temporary, transformers, typed-process

Files

• ChangeLog.md +3/−0
• LICENSE +20/−0
• README.md +485/−0
• Setup.hs +2/−0
• src/System/Process/Typed.hs +824/−0
• test/Spec.hs +1/−0
• test/System/Process/TypedSpec.hs +91/−0
• typed-process.cabal +51/−0

@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial commit

@@ -0,0 +1,20 @@+Copyright (c) 2016 FP Complete, https://www.fpcomplete.com/++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.

@@ -0,0 +1,485 @@+## typed-process++[![Build Status](https://travis-ci.org/fpco/typed-process.svg?branch=master)](https://travis-ci.org/fpco/typed-process) [![Build status](https://ci.appveyor.com/api/projects/status/bhh7aekbgeqp7g5j/branch/master?svg=true)](https://ci.appveyor.com/project/snoyberg/typed-process/branch/master)++This library provides the ability to launch and interact with external+processes. It wraps around the+[process library](https://haskell-lang.org/library/process), and+intends to improve upon it by:++1. Using type variables to represent the standard streams, making them+   easier to manipulate+2. Use proper concurrency (e.g., the async library) in place of the+   weird lazy I/O tricks for such things as consuming output streams+3. Allow for more complex concurrency by providing STM-based functions+4. Using binary I/O correctly+5. Providing a more composable API, designed to be easy to use for+   both simple and complex use cases++## Synopsis++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.IO (hPutStr, hClose)+import System.Process.Typed+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8+import Control.Concurrent.STM (atomically)+import Control.Exception (throwIO)++main :: IO ()+main = do+    -- Run a process, print its exit code+    runProcess "true" >>= print+    runProcess "false" >>= print++    -- Check that the exit code is a success+    runProcess_ "true"+    -- This will throw an exception: runProcess_ "false"++    -- Capture output and error+    (dateOut, dateErr) <- readProcess_ "date"+    print (dateOut, dateErr)++    -- Use shell commands+    (dateOut2, dateErr2) <- readProcess_ "date >&2"+    print (dateOut2, dateErr2)++    -- Interact with a process+    let catConfig = setStdin createPipe+                  $ setStdout byteStringOutput+                  $ proc "cat" ["/etc/hosts", "-", "/etc/group"]+    withProcess_ catConfig $ \p -> do+        hPutStr (getStdin p) "\n\nHELLO\n"+        hPutStr (getStdin p) "WORLD\n\n\n"+        hClose (getStdin p)++        atomically (getStdout p) >>= L8.putStr+```++## Types++The two primary types in this package are `ProcessConfig` and+`Process`. `ProcessConfig` gives a specification for how to run a+process (e.g., the command to run, working directory, environment+variables) and how to deal with the three standard streams: input,+output, and error. You use one of the functions in this package for+launching a process to turn a `ProcessConfig` into a `Process`, which+represents an actual running system process.++The easiest way to create a `ProcessConfig` is using the `IsString`+instance and `OverloadedStrings`. For example, to run the `date`+command, we can do the following. (NOTE: The type signatures used here+are simply to spell things out, they are not needed.)++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = do+    let dateConfig :: ProcessConfig () () ()+        dateConfig = "date"++    process <- startProcess dateConfig+    exitCode <- waitExitCode (process :: Process () () ())+    print exitCode++    stopProcess process+```++This shows the general workflow: use `startProcess` to launch a+`Process` from a `ProcessConfig`, interact with it (such as+`waitExitCode` to wait for the process to exit), and then clean up+resources with `stopProcess`. (We'll get to those `() () ()` type+parameters in the next section.)++Instead of explicitly dealing with `startProcess` and `stopProcess`,+it's recommended to instead use `withProcess`, which uses the bracket+pattern and is exception safe:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = withProcess "date" $ \process -> do+    exitCode <- waitExitCode (process :: Process () () ())+    print exitCode+```++But this pattern of running a process, waiting for it to exit, and+getting its exit code is very common, so it has a helper function of+its own:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = do+    exitCode <- runProcess "date"+    print exitCode+```++We'll discuss some functions which automatically check the exit code+below.++## Type parameters++Both `ProcessConfig` and `Process` each take three type parameters,+with the type of the standard input, output, and error streams for the+process. As you saw above, our default is `()` for each, and our+default behavior is to inherit the streams from the parent+process. This is why, when you run the previous programs, the `date`+program's output goes directly to your console.++We can override these defaults in a number of ways. Perhaps the+easiest is to simply close the stream for the child so it cannot use+it at all.++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = do+    let dateConfig :: ProcessConfig () () ()+        dateConfig = setStdin closed+                   $ setStdout closed+                   $ setStderr closed+                     "date"+    exitCode <- runProcess dateConfig+    print exitCode+```++A few things to note:++* The type parameter is still `()`, since there's no data to+  return. We'll see some more interesting cases later.+* This process now returns an `ExitFailure 1`, since it tries to write+  to a closed `stdout` file descriptor.++## Using `proc` and `shell`++Using the `OverloadedStrings` approach works nicely for some cases,+but we'll often want more control over things. There are two smart+constructors available: `proc` takes a command and list of arguments,+and `shell` takes a single string which will be passed directly to the+system's shell.++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = do+    -- Command and arguments+    runProcess (proc "cat" ["/etc/hosts"]) >>= print++    -- Shell+    runProcess (shell "cat /etc/hosts >&2 && false") >>= print+```++The behavior of the `OverloadedStrings` approach we've used until now+is actually based on these two smart constructors. If you provide it a+string without any spaces (like `"date"`), it will use `proc` without+any arguments, e.g. `fromString "date" = proc "date" []`. If there are+any spaces in the string, it will use `shell`.++__EXERCISE__: Rewrite the previous example to not use the `shell`+constructor.++## Checking the exit code++We've done a lot of printing of exit codes. In many cases, we don't+actually want to look at the exit code, but instead just throw an+exception if the process failed. Fortunately, we have such an+exit-code-checking function.++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = runProcess_ "date"+```++By adding the `_` at the end of `runProcess`, we're now automatically+checking the exit code and throwing an exception if it returns+anything but success. Want to see it in action?++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = runProcess_ "false"+```++Under the surface, this function is using the `checkExitCode`+function. We can do this more explicitly if desired:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = withProcess "false" checkExitCode+```++## Reading from a process++Sending all output to the parent process's handles is sometimes+desired, but often we'd rather just capture that output. The easiest+way to do that is to capture it in memory as a lazy+`ByteString`. Fortunately, we have a helper `readProcess` function for+that:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed+import System.Exit (ExitCode)+import Data.ByteString.Lazy (ByteString)++main :: IO ()+main = do+    (exitCode, out, err) <- readProcess "date"+    print (exitCode :: ExitCode)+    print (out :: ByteString)+    print (err :: ByteString)+```++One thing to point out is that, even though this is a lazy+`ByteString`, it is not using any lazy I/O. When `readProcess` exits,+the output has been fully generated, and is resident in memory. We+only use a lazy `ByteString` instead of a strict one for better memory+configuration (chunking into multiple smaller bits instead of one+massive chunk of data).++Like `runProcess`, there's an exit-code-checking variant of+`readProcess`:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed+import Data.ByteString.Lazy (ByteString)++main :: IO ()+main = do+    (out, err) <- readProcess_ "date"+    print (out :: ByteString)+    print (err :: ByteString)+```++__EXERCISE__: Use shell redirection to move the output from standard+output to standard error.++## Redirecting to a file++Another technique we'll commonly want to employ is to redirect output+from a process to a file. This is superior to the memory approach as+it does not have the risk of using large amounts of memory, though it+is more inconvenient. Together with the+[temporary library](https://www.stackage.org/package/temporary), we+can do some nice things:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed+import System.IO.Temp (withSystemTempFile)++main :: IO ()+main = withSystemTempFile "date" $ \fp h -> do+    let dateConfig = setStdin closed+                   $ setStdout (useHandleClose h)+                   $ setStderr closed+                     "date"++    runProcess_ dateConfig++    readFile fp >>= print+```++The `useHandleClose` function lets us provide an already existing+`Handle`, and will close it when done. If you want to write the output+of multiple processes to a single file, you can instead use+`useHandleOpen`:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed+import System.IO (hClose)+import System.IO.Temp (withSystemTempFile)+import Control.Monad (replicateM_)++main :: IO ()+main = withSystemTempFile "date" $ \fp h -> do+    let dateConfig = setStdin closed+                   $ setStdout (useHandleOpen h)+                   $ setStderr closed+                     "date"++    replicateM_ 10 $ runProcess_ dateConfig+    hClose h++    readFile fp >>= putStrLn+```++__EXERCISE__ Create a separate file for error output and capture that+as well.++## Providing input++Using `OverloadedStrings`, it's trivial to provide some input to a+process:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = runProcess_ $ setStdin "Hello World!\n" "cat"+```++This is just a shortcut for using the `byteStringInput` function:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = runProcess_ $ setStdin (byteStringInput "Hello World!\n") "cat"+```++But like output and error, we can also use a `Handle` or a temporary+file:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed+import System.IO+import System.IO.Temp (withSystemTempFile)++main :: IO ()+main = withSystemTempFile "input" $ \fp h -> do+    hPutStrLn h "Hello World!"+    hClose h++    withBinaryFile fp ReadMode $ \h' ->+        runProcess_ $ setStdin (useHandleClose h') "cat"+```++## Interacting with a process++So far, everything we've done has been _running_ processes: spawning a+child with some settings, then waiting for it to exit. We will often+want to _interact_ with a process: spawn it, and then send it input or+receive output from it while it is still running.++For this, using `createPipe` makes a lot of sense:++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed+import System.IO++main :: IO ()+main = do+    let catConfig = setStdin createPipe+                  $ setStdout createPipe+                  $ setStderr closed+                    "cat"++    withProcess_ catConfig $ \p -> do+        hPutStrLn (getStdin p) "Hello!"+        hFlush (getStdin p)+        hGetLine (getStdout p) >>= print++        hClose (getStdin p)+```++__EXERCISE__: What happens if you remove the `hClose` line, and why?+Hint: what happens if you both remove `hClose` _and_ replace+`withProcess_` with `withProcess`?++## Other settings++We've so far only played with modifying streams, but there are a+number of other settings you can tweak. It's best to just look at the+API docs for all available functions. We'll give examples of the two+most common settings: the working directory and environment variables.++```haskell+#!/usr/bin/env stack+-- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+{-# LANGUAGE OverloadedStrings #-}+import System.Process.Typed++main :: IO ()+main = do+    putStrLn "1:"+    runProcess_ "pwd"+    putStrLn "\n2:"+    runProcess_ $ setWorkingDir "/tmp" "pwd"++    putStrLn "\n3:"+    runProcess_ "env"+    putStrLn "\n4:"+    runProcess_ $ setEnv [("HELLO", "WORLD")] "env"+```++## Async and STM++When interacting with a process on multiple streams, you'll often want+to use some kind of concurrency. The strong recommendation is to use+the+[async library](https://haskell-lang.org/library/async). Additionally,+this library provides a number of functions that use STM, which also+plays very nicely with concurrency and the async package. For some+examples, check out:++* `waitExitCodeSTM`+* `getExitCodeSTM`+* `checkExitCodeSTM`+* `byteStringOutput`++__EXERCISE__ Reimplement the `readProcess` function using+`byteStringOutput` and `waitExitCodeSTM`.++__EXERCISE__ Reimplement the `readProcess_` function using+`byteStringOutput` and `checkExitCodeSTM`.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,824 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | Please see the README.md file for examples of using this API.+module System.Process.Typed+    ( -- * Types+      ProcessConfig+    , StreamSpec+    , StreamType (..)+    , Process++      -- * ProcessConfig+      -- ** Smart constructors+    , proc+    , shell++      -- ** Setters+    , setStdin+    , setStdout+    , setStderr+    , setWorkingDir+    , setEnv+    , setCloseFds+    , setCreateGroup+    , setDelegateCtlc+#if MIN_VERSION_process(1, 3, 0)+    , setDetachConsole+    , setCreateNewConsole+    , setNewSession+#endif+#if MIN_VERSION_process(1, 4, 0) && !WINDOWS+    , setChildGroup+    , setChildUser+#endif++      -- * Stream specs+    , mkStreamSpec+    , inherit+    , closed+    , byteStringInput+    , byteStringOutput+    , createPipe+    , useHandleOpen+    , useHandleClose++      -- ** Conduit+    , createSink+    , createSource++      -- * Launch a process+    , startProcess+    , stopProcess+    , withProcess+    , withProcess_+    , readProcess+    , readProcess_+    , runProcess+    , runProcess_++      -- * Interact with a process++      -- ** Process exit code+    , waitExitCode+    , waitExitCodeSTM+    , getExitCode+    , getExitCodeSTM+    , checkExitCode+    , checkExitCodeSTM++      -- ** Process streams+    , getStdin+    , getStdout+    , getStderr++      -- * Exceptions+    , ExitCodeException (..)+    , ByteStringOutputException (..)+    ) where++import qualified Data.ByteString as S+import Data.ByteString.Lazy.Internal (defaultChunkSize)+import Control.Exception (throwIO)+import Control.Monad (void)+import Control.Monad.IO.Class+import qualified System.Process as P+import Control.Monad.Catch as C+import Data.Typeable (Typeable)+import System.IO (Handle, hClose)+import Control.Concurrent.Async (async, cancel, waitCatch)+import Control.Concurrent.STM (newEmptyTMVarIO, atomically, putTMVar, TMVar, readTMVar, tryReadTMVar, STM, tryPutTMVar, throwSTM, catchSTM)+import System.Exit (ExitCode (ExitSuccess))+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8+import Data.String (IsString (fromString))+import Data.Conduit (ConduitM)+import qualified Data.Conduit as C+import qualified Data.Conduit.Binary as CB++#if MIN_VERSION_process(1, 4, 0) && !WINDOWS+import System.Posix.Types (GroupID, UserID)+#endif++#if !MIN_VERSION_base(4, 8, 0)+import Control.Applicative (Applicative (..), (<$>), (<$))+#endif++#if !MIN_VERSION_process(1, 3, 0)+import qualified System.Process.Internals as P (createProcess_)+#endif++-- | An abstract configuration for a process, which can then be+-- launched into an actual running 'Process'. Takes three type+-- parameters, providing the types of standard input, standard output,+-- and standard error, respectively.+--+-- There are three ways to construct a value of this type:+--+-- * With the 'proc' smart constructor, which takes a command name and+-- a list of arguments.+--+-- * With the 'shell' smart constructor, which takes a shell string+--+-- * With the 'IsString' instance via OverloadedStrings. If you+-- provide it a string with no spaces (e.g., @"date"@), it will+-- treat it as a raw command with no arguments (e.g., @proc "date"+-- []@). If it has spaces, it will use @shell@.+--+-- In all cases, the default for all three streams is to inherit the+-- streams from the parent process. For other settings, see the+-- setters below for default values.+--+-- @since 0.1.0.0+data ProcessConfig stdin stdout stderr = ProcessConfig+    { pcCmdSpec :: !P.CmdSpec+    , pcStdin :: !(StreamSpec 'STInput stdin)+    , pcStdout :: !(StreamSpec 'STOutput stdout)+    , pcStderr :: !(StreamSpec 'STOutput stderr)+    , pcWorkingDir :: !(Maybe FilePath)+    , pcEnv :: !(Maybe [(String, String)])+    , pcCloseFds :: !Bool+    , pcCreateGroup :: !Bool+    , pcDelegateCtlc :: !Bool++#if MIN_VERSION_process(1, 3, 0)+    , pcDetachConsole :: !Bool+    , pcCreateNewConsole :: !Bool+    , pcNewSession :: !Bool+#endif++#if MIN_VERSION_process(1, 4, 0) && !WINDOWS+    , pcChildGroup :: !(Maybe GroupID)+    , pcChildUser :: !(Maybe UserID)+#endif+    }+instance Show (ProcessConfig stdin stdout stderr) where+    show pc = concat+        [ case pcCmdSpec pc of+            P.ShellCommand s -> "Shell command: " ++ s+            P.RawCommand x xs -> "Raw command: " ++ unwords (map escape (x:xs))+        , "\n"+        , case pcWorkingDir pc of+            Nothing -> ""+            Just wd -> concat+                [ "Run from: "+                , wd+                , "\n"+                ]+        , case pcEnv pc of+            Nothing -> ""+            Just e -> unlines+                $ "Modified environment:"+                : map (\(k, v) -> concat [k, "=", v]) e+        ]+      where+        escape x+            | any (`elem` " \\\"'") x = show x+            | otherwise = x+instance (stdin ~ (), stdout ~ (), stderr ~ ())+  => IsString (ProcessConfig stdin stdout stderr) where+    fromString s+        | any (== ' ') s = shell s+        | otherwise = proc s []++-- | Whether a stream is an input stream or output stream. Note that+-- this is from the perspective of the /child process/, so that a+-- child's standard input stream is an @STInput@, even though the+-- parent process will be writing to it.+--+-- @since 0.1.0.0+data StreamType = STInput | STOutput++-- | A specification for how to create one of the three standard child+-- streams. See examples below.+--+-- @since 0.1.0.0+data StreamSpec (streamType :: StreamType) a = StreamSpec+    { ssStream :: !P.StdStream+    , ssCreate :: !(ProcessConfig () () () -> Maybe Handle -> Cleanup a)+    }+    deriving Functor++-- | This instance uses 'byteStringInput' to convert a raw string into+-- a stream of input for a child process.+--+-- @since 0.1.0.0+instance (streamType ~ 'STInput, res ~ ())+  => IsString (StreamSpec streamType res) where+    fromString = byteStringInput . fromString++-- | Internal type, to make for easier composition of cleanup actions.+--+-- @since 0.1.0.0+newtype Cleanup a = Cleanup { runCleanup :: IO (a, IO ()) }+    deriving Functor+instance Applicative Cleanup where+    pure x = Cleanup (return (x, return ()))+    Cleanup f <*> Cleanup x = Cleanup $ do+        (f', c1) <- f+        (`onException` c1) $ do+            (x', c2) <- x+            return (f' x', c1 `finally` c2)++-- | A running process. The three type parameters provide the type of+-- the standard input, standard output, and standard error streams.+--+-- @since 0.1.0.0+data Process stdin stdout stderr = Process+    { pConfig :: !(ProcessConfig () () ())+    , pCleanup :: !(IO ())+    , pStdin :: !stdin+    , pStdout :: !stdout+    , pStderr :: !stderr+    , pHandle :: !P.ProcessHandle+    , pExitCode :: !(TMVar ExitCode)+    }+instance Show (Process stdin stdout stderr) where+    show p = "Running process: " ++ show (pConfig p)++-- | Internal helper+defaultProcessConfig :: ProcessConfig () () ()+defaultProcessConfig = ProcessConfig+    { pcCmdSpec = P.ShellCommand ""+    , pcStdin = inherit+    , pcStdout = inherit+    , pcStderr = inherit+    , pcWorkingDir = Nothing+    , pcEnv = Nothing+    , pcCloseFds = False+    , pcCreateGroup = False+    , pcDelegateCtlc = False++#if MIN_VERSION_process(1, 3, 0)+    , pcDetachConsole = False+    , pcCreateNewConsole = False+    , pcNewSession = False+#endif++#if MIN_VERSION_process(1, 4, 0) && !WINDOWS+    , pcChildGroup = Nothing+    , pcChildUser = Nothing+#endif+    }++-- | Create a 'ProcessConfig' from the given command and arguments.+--+-- @since 0.1.0.0+proc :: FilePath -> [String] -> ProcessConfig () () ()+proc cmd args = setProc cmd args defaultProcessConfig++-- | Internal helper+setProc :: FilePath -> [String]+        -> ProcessConfig stdin stdout stderr+        -> ProcessConfig stdin stdout stderr+setProc cmd args p = p { pcCmdSpec = P.RawCommand cmd args }++-- | Create a 'ProcessConfig' from the given shell command.+--+-- @since 0.1.0.0+shell :: String -> ProcessConfig () () ()+shell cmd = setShell cmd defaultProcessConfig++-- | Internal helper+setShell :: String+         -> ProcessConfig stdin stdout stderr+         -> ProcessConfig stdin stdout stderr+setShell cmd p = p { pcCmdSpec = P.ShellCommand cmd }++-- | Set the child's standard input stream to the given 'StreamSpec'.+--+-- Default: 'inherit'+--+-- @since 0.1.0.0+setStdin :: StreamSpec 'STInput stdin+         -> ProcessConfig stdin0 stdout stderr+         -> ProcessConfig stdin stdout stderr+setStdin spec pc = pc { pcStdin = spec }++-- | Set the child's standard output stream to the given 'StreamSpec'.+--+-- Default: 'inherit'+--+-- @since 0.1.0.0+setStdout :: StreamSpec 'STOutput stdout+          -> ProcessConfig stdin stdout0 stderr+          -> ProcessConfig stdin stdout stderr+setStdout spec pc = pc { pcStdout = spec }++-- | Set the child's standard error stream to the given 'StreamSpec'.+--+-- Default: 'inherit'+--+-- @since 0.1.0.0+setStderr :: StreamSpec 'STOutput stderr+          -> ProcessConfig stdin stdout stderr0+          -> ProcessConfig stdin stdout stderr+setStderr spec pc = pc { pcStderr = spec }++-- | Set the working directory of the child process.+--+-- Default: current process's working directory.+--+-- @since 0.1.0.0+setWorkingDir :: FilePath+              -> ProcessConfig stdin stdout stderr+              -> ProcessConfig stdin stdout stderr+setWorkingDir dir pc = pc { pcWorkingDir = Just dir }++-- | Set the environment variables of the child process.+--+-- Default: current process's environment.+--+-- @since 0.1.0.0+setEnv :: [(String, String)]+       -> ProcessConfig stdin stdout stderr+       -> ProcessConfig stdin stdout stderr+setEnv env pc = pc { pcEnv = Just env }++-- | Should we close all file descriptors besides stdin, stdout, and+-- stderr? See 'P.close_fds' for more information.+--+-- Default: False+--+-- @since 0.1.0.0+setCloseFds+    :: Bool+    -> ProcessConfig stdin stdout stderr+    -> ProcessConfig stdin stdout stderr+setCloseFds x pc = pc { pcCloseFds = x }++-- | Should we create a new process group?+--+-- Default: False+--+-- @since 0.1.0.0+setCreateGroup+    :: Bool+    -> ProcessConfig stdin stdout stderr+    -> ProcessConfig stdin stdout stderr+setCreateGroup x pc = pc { pcCreateGroup = x }++-- | Delegate handling of Ctrl-C to the child. For more information,+-- see 'P.delegate_ctlc'.+--+-- Default: False+--+-- @since 0.1.0.0+setDelegateCtlc+    :: Bool+    -> ProcessConfig stdin stdout stderr+    -> ProcessConfig stdin stdout stderr+setDelegateCtlc x pc = pc { pcDelegateCtlc = x }++#if MIN_VERSION_process(1, 3, 0)++-- | Detach console on Windows, see 'P.detach_console'.+--+-- Default: False+--+-- @since 0.1.0.0+setDetachConsole+    :: Bool+    -> ProcessConfig stdin stdout stderr+    -> ProcessConfig stdin stdout stderr+setDetachConsole x pc = pc { pcDetachConsole = x }++-- | Create new console on Windows, see 'P.create_new_console'.+--+-- Default: False+--+-- @since 0.1.0.0+setCreateNewConsole+    :: Bool+    -> ProcessConfig stdin stdout stderr+    -> ProcessConfig stdin stdout stderr+setCreateNewConsole x pc = pc { pcCreateNewConsole = x }++-- | Set a new session with the POSIX @setsid@ syscall, does nothing+-- on non-POSIX. See 'P.new_session'.+--+-- Default: False+--+-- @since 0.1.0.0+setNewSession+    :: Bool+    -> ProcessConfig stdin stdout stderr+    -> ProcessConfig stdin stdout stderr+setNewSession x pc = pc { pcNewSession = x }+#endif++#if MIN_VERSION_process(1, 4, 0) && !WINDOWS+-- | Set the child process's group ID with the POSIX @setgid@ syscall,+-- does nothing on non-POSIX. See 'P.child_group'.+--+-- Default: False+--+-- @since 0.1.0.0+setChildGroup+    :: GroupID+    -> ProcessConfig stdin stdout stderr+    -> ProcessConfig stdin stdout stderr+setChildGroup x pc = pc { pcChildGroup = Just x }++-- | Set the child process's user ID with the POSIX @setuid@ syscall,+-- does nothing on non-POSIX. See 'P.child_user'.+--+-- Default: False+--+-- @since 0.1.0.0+setChildUser+    :: UserID+    -> ProcessConfig stdin stdout stderr+    -> ProcessConfig stdin stdout stderr+setChildUser x pc = pc { pcChildUser = Just x }+#endif++-- | Create a new 'StreamSpec' from the given 'P.StdStream' and a+-- helper function. This function:+--+-- * Takes as input the raw @Maybe Handle@ returned by the+-- 'P.createProcess' function. This will be determined by the+-- 'P.StdStream' argument.+--+-- * Returns the actual stream value @a@, as well as a cleanup+-- * function to be run when calling 'stopProcess'.+--+-- @since 0.1.0.0+mkStreamSpec :: P.StdStream+             -> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))+             -> StreamSpec streamType a+mkStreamSpec ss f = StreamSpec ss (\pc mh -> Cleanup (f pc mh))++-- | A stream spec which simply inherits the stream of the parent+-- process.+--+-- @since 0.1.0.0+inherit :: StreamSpec anyStreamType ()+inherit = mkStreamSpec P.Inherit (\_ Nothing -> pure ((), return ()))++-- | A stream spec which will close the stream for the child process.+--+-- @since 0.1.0.0+closed :: StreamSpec anyStreamType ()+#if MIN_VERSION_process(1, 4, 0)+closed = mkStreamSpec P.NoStream (\_ Nothing -> pure ((), return ()))+#else+closed = mkStreamSpec P.CreatePipe (\_ (Just h) -> (((), return ()) <$ hClose h))+#endif++-- | An input stream spec which sets the input to the given+-- 'L.ByteString'. A separate thread will be forked to write the+-- contents to the child process.+--+-- @since 0.1.0.0+byteStringInput :: L.ByteString -> StreamSpec 'STInput ()+byteStringInput lbs = mkStreamSpec P.CreatePipe $ \_ (Just h) -> do+    void $ async $ do+        L.hPut h lbs+        hClose h+    return ((), hClose h)++-- | Capture the output of a process in a 'L.ByteString'.+--+-- This function will fork a separate thread to consume all input from+-- the process, and will only make the results available when the+-- underlying 'Handle' is closed. As this is provided as an 'STM'+-- action, you can either check if the result is available, or block+-- until it's ready.+--+-- In the event of any exception occurring when reading from the+-- 'Handle', the 'STM' action will throw a+-- 'ByteStringOutputException'.+--+-- @since 0.1.0.0+byteStringOutput :: StreamSpec 'STOutput (STM L.ByteString)+byteStringOutput = mkStreamSpec P.CreatePipe $ \pc (Just h) -> do+    mvar <- newEmptyTMVarIO++    void $ async $ do+        let loop front = do+                bs <- S.hGetSome h defaultChunkSize+                if S.null bs+                    then atomically $ putTMVar mvar $ Right $ L.fromChunks $ front []+                    else loop $ front . (bs:)+        loop id `catch` \e -> do+            atomically $ void $ tryPutTMVar mvar $ Left $ ByteStringOutputException e pc+            throwIO e++    return (readTMVar mvar >>= either throwSTM return, hClose h)++-- | Create a new pipe between this process and the child, and return+-- a 'Handle' to communicate with the child.+--+-- @since 0.1.0.0+createPipe :: StreamSpec anyStreamType Handle+createPipe = mkStreamSpec P.CreatePipe $ \_ (Just h) -> return (h, hClose h)++-- | Use the provided 'Handle' for the child process, and when the+-- process exits, do /not/ close it. This is useful if, for example,+-- you want to have multiple processes write to the same log file+-- sequentially.+--+-- @since 0.1.0.0+useHandleOpen :: Handle -> StreamSpec anyStreamType ()+useHandleOpen h = mkStreamSpec (P.UseHandle h) $ \_ Nothing -> return ((), return ())++-- | Use the provided 'Handle' for the child process, and when the+-- process exits, close it. If you have no reason to keep the 'Handle'+-- open, you should use this over 'useHandleOpen'.+--+-- @since 0.1.0.0+useHandleClose :: Handle -> StreamSpec anyStreamType ()+useHandleClose h = mkStreamSpec (P.UseHandle h) $ \_ Nothing -> return ((), hClose h)++-- | Provide input to a process by writing to a conduit.+--+-- @since 0.1.0.0+createSink :: MonadIO m => StreamSpec 'STInput (ConduitM S.ByteString o m ())+createSink =+    (\h -> C.addCleanup (\_ -> liftIO $ hClose h) (CB.sinkHandle h))+    <$> createPipe++-- | Read output from a process by read from a conduit.+--+-- @since 0.1.0.0+createSource :: MonadIO m => StreamSpec 'STOutput (ConduitM i S.ByteString m ())+createSource =+    (\h -> C.addCleanup (\_ -> liftIO $ hClose h) (CB.sourceHandle h))+    <$> createPipe++-- | Launch a process based on the given 'ProcessConfig'. You should+-- ensure that you close 'stopProcess' on the result. It's usually+-- better to use one of the functions in this module which ensures+-- 'stopProcess' is called, such as 'withProcess'.+--+-- @since 0.1.0.0+startProcess :: MonadIO m+             => ProcessConfig stdin stdout stderr+             -> m (Process stdin stdout stderr)+startProcess pConfig'@ProcessConfig {..} = liftIO $ do+    let cp0 =+            case pcCmdSpec of+                P.ShellCommand cmd -> P.shell cmd+                P.RawCommand cmd args -> P.proc cmd args+        cp = cp0+            { P.std_in = ssStream pcStdin+            , P.std_out = ssStream pcStdout+            , P.std_err = ssStream pcStderr+            , P.cwd = pcWorkingDir+            , P.env = pcEnv+            , P.close_fds = pcCloseFds+            , P.create_group = pcCreateGroup+            , P.delegate_ctlc = pcDelegateCtlc++#if MIN_VERSION_process(1, 3, 0)+            , P.detach_console = pcDetachConsole+            , P.create_new_console = pcCreateNewConsole+            , P.new_session = pcNewSession+#endif++#if MIN_VERSION_process(1, 4, 0) && !WINDOWS+            , P.child_group = pcChildGroup+            , P.child_user = pcChildUser+#endif++            }++    (minH, moutH, merrH, pHandle) <- P.createProcess_ "startProcess" cp++    ((pStdin, pStdout, pStderr), pCleanup1) <- runCleanup $ (,,)+        <$> ssCreate pcStdin  pConfig minH+        <*> ssCreate pcStdout pConfig moutH+        <*> ssCreate pcStderr pConfig merrH++    pExitCode <- newEmptyTMVarIO+    waitingThread <- async $ do+        ec <- P.waitForProcess pHandle+        atomically $ putTMVar pExitCode ec+        return ec++    let pCleanup = pCleanup1 `finally` do+            -- First: stop calling waitForProcess, so that we can+            -- avoid race conditions where the process is removed from+            -- the system process table while we're trying to+            -- terminate it.+            cancel waitingThread++            -- Now check if the process had already exited+            eec <- waitCatch waitingThread++            case eec of+                -- Process already exited, nothing to do+                Right _ec -> return ()++                -- Process didn't exit yet, let's terminate it and+                -- then call waitForProcess ourselves+                Left _ -> do+                    P.terminateProcess pHandle+                    void $ P.waitForProcess pHandle++    return Process {..}+  where+    pConfig = clearStreams pConfig'++-- | Close a process and release any resources acquired. This will+-- ensure 'P.terminateProcess' is called, wait for the process to+-- actually exit, and then close out resources allocated for the+-- streams. In the event of any cleanup exceptions being thrown this+-- will throw an exception.+--+-- @since 0.1.0.0+stopProcess :: MonadIO m+            => Process stdin stdout stderr+            -> m ()+stopProcess = liftIO . pCleanup++-- | Use the bracket pattern to call 'startProcess' and ensure+-- 'stopProcess' is called.+--+-- @since 0.1.0.0+withProcess :: (MonadIO m, C.MonadMask m)+            => ProcessConfig stdin stdout stderr+            -> (Process stdin stdout stderr -> m a)+            -> m a+withProcess config = C.bracket (startProcess config) stopProcess++-- | Same as 'withProcess', but also calls 'checkExitCode'+--+-- @since 0.1.0.0+withProcess_ :: (MonadIO m, C.MonadMask m)+             => ProcessConfig stdin stdout stderr+             -> (Process stdin stdout stderr -> m a)+             -> m a+withProcess_ config = C.bracket+    (startProcess config)+    (\p -> stopProcess p `finally` checkExitCode p)++-- | Run a process, capture its standard output and error as a+-- 'L.ByteString', wait for it to complete, and then return its exit+-- code, output, and error.+--+-- Note that any previously used 'setStdout' or 'setStderr' will be+-- overridden.+--+-- @since 0.1.0.0+readProcess :: MonadIO m+            => ProcessConfig stdin stdoutIgnored stderrIgnored+            -> m (ExitCode, L.ByteString, L.ByteString)+readProcess pc =+    liftIO $ withProcess pc' $ \p -> atomically $ (,,)+        <$> waitExitCodeSTM p+        <*> getStdout p+        <*> getStderr p+  where+    pc' = setStdout byteStringOutput+        $ setStderr byteStringOutput pc++-- | Same as 'readProcess', but instead of returning the 'ExitCode',+-- checks it with 'checkExitCode'.+--+-- @since 0.1.0.0+readProcess_ :: MonadIO m+             => ProcessConfig stdin stdoutIgnored stderrIgnored+             -> m (L.ByteString, L.ByteString)+readProcess_ pc =+    liftIO $ withProcess pc' $ \p -> atomically $ do+        stdout <- getStdout p+        stderr <- getStderr p+        checkExitCodeSTM p `catchSTM` \ece -> throwSTM ece+            { eceStdout = stdout+            , eceStderr = stderr+            }+        return (stdout, stderr)+  where+    pc' = setStdout byteStringOutput+        $ setStderr byteStringOutput pc++-- | Run the given process, wait for it to exit, and returns its+-- 'ExitCode'.+--+-- @since 0.1.0.0+runProcess :: MonadIO m+           => ProcessConfig stdin stdout stderr+           -> m ExitCode+runProcess pc = liftIO $ withProcess pc waitExitCode++-- | Same as 'runProcess', but ignores the 'ExitCode'.+--+-- @since 0.1.0.0+runProcess_ :: MonadIO m+            => ProcessConfig stdin stdout stderr+            -> m ()+runProcess_ pc = liftIO $ withProcess pc checkExitCode++-- | Wait for the process to exit and then return its 'ExitCode'.+--+-- @since 0.1.0.0+waitExitCode :: MonadIO m => Process stdin stdout stderr -> m ExitCode+waitExitCode = liftIO . atomically . waitExitCodeSTM++-- | Same as 'waitExitCode', but in 'STM'.+--+-- @since 0.1.0.0+waitExitCodeSTM :: Process stdin stdout stderr -> STM ExitCode+waitExitCodeSTM = readTMVar . pExitCode++-- | Check if a process has exited and, if so, return its 'ExitCode'.+--+-- @since 0.1.0.0+getExitCode :: MonadIO m => Process stdin stdout stderr -> m (Maybe ExitCode)+getExitCode = liftIO . atomically . getExitCodeSTM++-- | Same as 'getExitCode', but in 'STM'.+--+-- @since 0.1.0.0+getExitCodeSTM :: Process stdin stdout stderr -> STM (Maybe ExitCode)+getExitCodeSTM = tryReadTMVar . pExitCode++-- | Wait for a process to exit, and ensure that it exited+-- successfully. If not, throws an 'ExitCodeException'.+--+-- @since 0.1.0.0+checkExitCode :: MonadIO m => Process stdin stdout stderr -> m ()+checkExitCode = liftIO . atomically . checkExitCodeSTM++-- | Same as 'checkExitCode', but in 'STM'.+--+-- @since 0.1.0.0+checkExitCodeSTM :: Process stdin stdout stderr -> STM ()+checkExitCodeSTM p = do+    ec <- readTMVar (pExitCode p)+    case ec of+        ExitSuccess -> return ()+        _ -> throwSTM ExitCodeException+            { eceExitCode = ec+            , eceProcessConfig = clearStreams (pConfig p)+            , eceStdout = L.empty+            , eceStderr = L.empty+            }++-- | Internal+clearStreams :: ProcessConfig stdin stdout stderr -> ProcessConfig () () ()+clearStreams pc = pc+    { pcStdin = inherit+    , pcStdout = inherit+    , pcStderr = inherit+    }++-- | Get the child's standard input stream value.+--+-- @since 0.1.0.0+getStdin :: Process stdin stdout stderr -> stdin+getStdin = pStdin++-- | Get the child's standard output stream value.+--+-- @since 0.1.0.0+getStdout :: Process stdin stdout stderr -> stdout+getStdout = pStdout++-- | Get the child's standard error stream value.+--+-- @since 0.1.0.0+getStderr :: Process stdin stdout stderr -> stderr+getStderr = pStderr++-- | Exception thrown by 'checkExitCode' in the event of a non-success+-- exit code. Note that 'checkExitCode' is called by other functions+-- as well, like 'runProcess_' or 'readProcess_'.+--+-- @since 0.1.0.0+data ExitCodeException = ExitCodeException+    { eceExitCode :: ExitCode+    , eceProcessConfig :: ProcessConfig () () ()+    , eceStdout :: L.ByteString+    , eceStderr :: L.ByteString+    }+    deriving Typeable+instance Exception ExitCodeException+instance Show ExitCodeException where+    show ece = concat+        [ "Received "+        , show (eceExitCode ece)+        , " when running\n"+        , show (eceProcessConfig ece)+        , if L.null (eceStdout ece)+            then ""+            else "Standard output:\n\n" ++ L8.unpack (eceStdout ece)+        , if L.null (eceStderr ece)+            then ""+            else "Standard error:\n\n" ++ L8.unpack (eceStderr ece)+        ]++-- | Wrapper for when an exception is thrown when reading from a child+-- process, used by 'byteStringOutput'.+--+-- @since 0.1.0.0+data ByteStringOutputException = ByteStringOutputException SomeException (ProcessConfig () () ())+    deriving (Show, Typeable)+instance Exception ByteStringOutputException

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,91 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Process.TypedSpec (spec) where++import System.Process.Typed+import System.IO+import Data.Conduit+import qualified Data.Conduit.Binary as CB+import Network.HTTP.Simple+import Control.Concurrent.Async (Concurrently (..))+import Test.Hspec+import System.Exit+import System.IO.Temp+import qualified Data.ByteString as S+import Data.String (IsString)+import Data.Monoid ((<>))+import qualified Data.Conduit.List as CL+import qualified Data.ByteString.Base64 as B64++#if !MIN_VERSION_base(4, 8, 0)+import Control.Applicative ((*>))+#endif++spec :: Spec+spec = do+    it "bytestring stdin" $ do+        let bs :: IsString s => s+            bs = "this is a test"+        res <- readProcess (setStdin bs "cat")+        res `shouldBe` (ExitSuccess, bs, "")++    it "useHandleOpen" $ withSystemTempFile "use-handle-open" $ \fp h -> do+        let bs :: IsString s => s+            bs = "this is a test 2"+        S.hPut h bs+        hClose h+        res <- withBinaryFile fp ReadMode $ \h' -> do+            res <- readProcess (setStdin (useHandleOpen h') "cat")+            isOpen <- hIsOpen h'+            isOpen `shouldBe` True+            return res+        res `shouldBe` (ExitSuccess, bs, "")++    it "useHandleClose" $ withSystemTempFile "use-handle-close" $ \fp h -> do+        let bs :: IsString s => s+            bs = "this is a test 3"+        S.hPut h bs+        hClose h+        res <- withBinaryFile fp ReadMode $ \h' -> do+            res <- readProcess (setStdin (useHandleClose h') "cat")+            isOpen <- hIsOpen h'+            isOpen `shouldBe` False+            return res+        res `shouldBe` (ExitSuccess, bs, "")++    it "useHandleOpen+Close" $ withSystemTempFile "use-handle-open-close" $ \fp h -> do+        let bs1, bs2 :: IsString s => s+            bs1 = "this is a test 4\n"+            bs2 = "this is a test 5\n"++        runProcess_+            ( setStdout (useHandleOpen h)+            $ setStdin bs1 "cat")+        runProcess_+            ( setStdout (useHandleClose h)+            $ setStdin bs2 "cat")++        res <- S.readFile fp+        res `shouldBe` bs1 <> bs2++    it "unchecked exit code" $ do+        res <- runProcess "false"+        res `shouldBe` ExitFailure 1++    it "checked exit code" $+        runProcess_ "false" `shouldThrow` \ExitCodeException{} -> True++    it "async" $ withSystemTempFile "httpbin" $ \fp h -> do+        bss <- withProcess (setStdin createSink $ setStdout createSource "base64") $ \p ->+            runConcurrently $+                Concurrently+                    ( httpSink "https://raw.githubusercontent.com/fpco/typed-process/master/README.md" $ \_res ->+                    CB.conduitHandle h .| getStdin p) *>+                Concurrently+                    ( runConduit+                    $ getStdout p+                   .| CL.consume)+        hClose h+        let encoded = S.filter (/= 10) $ S.concat bss+        raw <- S.readFile fp+        encoded `shouldBe` B64.encode raw

@@ -0,0 +1,51 @@+name:                typed-process+version:             0.1.0.0+synopsis:            Run external processes, with strong typing of streams+description:         Please see README.md+homepage:            https://github.com/fpco/typed-process#readme+license:             MIT+license-file:        LICENSE+author:              Michael Snoyman+maintainer:          michael@snoyman.com+category:            System+build-type:          Simple+extra-source-files:  README.md ChangeLog.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     System.Process.Typed+  build-depends:       base >= 4.7 && < 5+                     , async+                     , bytestring+                     , conduit+                     , conduit-extra+                     , exceptions+                     , process >= 1.2+                     , stm+                     , transformers+  if os(windows)+    cpp-options:       -DWINDOWS+  default-language:    Haskell2010++test-suite typed-process-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       System.Process.TypedSpec+  build-depends:       base+                     , async+                     , base64-bytestring+                     , bytestring+                     , conduit+                     , conduit-extra+                     , hspec+                     , http-conduit >= 2.1.10+                     , temporary+                     , typed-process+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/fpco/typed-process