typed-process 0.2.3.0 → 0.2.13.0
raw patch · 6 files changed
Files
- ChangeLog.md +73/−0
- README.md +27/−26
- src/System/Process/Typed.hs +377/−602
- src/System/Process/Typed/Internal.hs +655/−0
- test/System/Process/TypedSpec.hs +85/−1
- typed-process.cabal +26/−17
ChangeLog.md view
@@ -1,3 +1,76 @@+# ChangeLog for typed-process++## 0.2.13.0++* Format stdout and stderr in `ExitCodeException` assuming they are in+ UTF-8. See [#87](https://github.com/fpco/typed-process/pull/87).+ Thanks to @9999years for the legwork on this change.++## 0.2.12.0++* Add `getPid`, `exitCodeExceptionWithOutput`,+ `exitCodeExceptionNoOutput`,++* Re-export `System.Process.Pid`++* Thanks to Rebecca Turner @9999years++## 0.2.11.1++* No user-visible changes++## 0.2.11.0++* Expose more from `System.Process.Typed.Internal`++## 0.2.10.0++* Add `mkPipeStreamSpec`++## 0.2.9.0++* Re-export `StdStream`++## 0.2.8.0++* Re-export `ExitCode`, `ExitSuccess` and `ExitFailure`.++## 0.2.7.0++* Include empty argument in the show instance.++## 0.2.6.3++* Doc improvements++## 0.2.6.2++* Doc improvements++## 0.2.6.1++* Doc improvements++## 0.2.6.0++* The cleanup thread applies an `unmask` to the actions which wait for a+ process to exit, allowing the action to be interruptible.++## 0.2.5.0++* Add a `nullStream` [#24](https://github.com/fpco/typed-process/pull/24)+* Add `withProcessWait`, `withProcessWait_`, `withProcessTerm`, and `withProcessTerm_`+ [#25](https://github.com/fpco/typed-process/issues/25)++## 0.2.4.1++* Fix a `Handle` leak in `withProcessInterleave` and its derivatives.++## 0.2.4.0++* Add `readProcessInterleaved` and `readProcessInterleaved_` to support+ capturing output from stdout and stderr in a single ByteString value.+ ## 0.2.3.0 * Add support for the single-threaded runtime via polling
README.md view
@@ -1,13 +1,13 @@ ## typed-process -[](https://travis-ci.org/fpco/typed-process) [](https://ci.appveyor.com/project/snoyberg/typed-process/branch/master)+[](https://github.com/fpco/typed-process/actions/workflows/tests.yml) API level documentation (Haddocks) may be [found on Stackage](https://www.stackage.org/package/typed-process). 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+[process library](https://hackage.haskell.org/package/process), and intends to improve upon it by: 1. Using type variables to represent the standard streams, making them@@ -29,7 +29,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.IO (hPutStr, hClose) import System.Process.Typed@@ -60,7 +60,7 @@ let catConfig = setStdin createPipe $ setStdout byteStringOutput $ proc "cat" ["/etc/hosts", "-", "/etc/group"]- withProcess_ catConfig $ \p -> do+ withProcessWait_ catConfig $ \p -> do hPutStr (getStdin p) "\n\nHELLO\n" hPutStr (getStdin p) "WORLD\n\n\n" hClose (getStdin p)@@ -85,14 +85,15 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = do let dateConfig :: ProcessConfig () () ()- dateConfig = "date"+ dateConfig = proc "date" []+ -- alternatively: `shell "date"` or just "date" process <- startProcess dateConfig exitCode <- waitExitCode (process :: Process () () ())@@ -108,17 +109,17 @@ parameters in the next section.) Instead of explicitly dealing with `startProcess` and `stopProcess`,-it's recommended to instead use `withProcess`, which uses the bracket+it's recommended to instead use `withProcessWait`, which uses the bracket pattern and is exception safe: ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO ()-main = withProcess "date" $ \process -> do+main = withProcessWait "date" $ \process -> do exitCode <- waitExitCode (process :: Process () () ()) print exitCode ```@@ -129,7 +130,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -157,7 +158,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -189,7 +190,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -220,7 +221,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -234,7 +235,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -247,12 +248,12 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO ()-main = withProcess "false" checkExitCode+main = withProcessWait "false" checkExitCode ``` ## Reading from a process@@ -265,7 +266,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.Exit (ExitCode)@@ -291,7 +292,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import Data.ByteString.Lazy (ByteString)@@ -312,12 +313,12 @@ 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-[`UnliftIO.Temporary`](https://www.stackage.org/haddock/lts-10.2/unliftio-0.2.2.0/UnliftIO-Temporary.html), we+[`UnliftIO.Temporary`](https://www.stackage.org/haddock/lts/unliftio/UnliftIO-Temporary.html), we can do some nice things: ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import UnliftIO.Temporary (withSystemTempFile)@@ -341,7 +342,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO (hClose)@@ -371,7 +372,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -383,7 +384,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -396,7 +397,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO@@ -422,7 +423,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO@@ -456,7 +457,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-10.2 script+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed
src/System/Process/Typed.hs view
@@ -3,10 +3,22 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}--- | Please see the README.md file for examples of using this API.+-- | The simplest way to get started with this API is to turn on+-- @OverloadedStrings@ and call 'runProcess'. The following will+-- write the contents of @/home@ to @stdout@ and then print the exit+-- code (on a UNIX system).+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+--+-- 'runProcess' "ls -l /home" >>= print+-- @+--+-- Please see the [README.md](https://github.com/fpco/typed-process#readme)+-- file for more examples of using this API. module System.Process.Typed ( -- * Types ProcessConfig@@ -19,6 +31,8 @@ , proc , shell + -- | #processconfigsetters#+ -- ** Setters , setStdin , setStdout@@ -42,9 +56,12 @@ , setChildUserInherit #endif + -- | #streamspecs#+ -- * Stream specs- , mkStreamSpec+ -- ** Built-in stream specs , inherit+ , nullStream , closed , byteStringInput , byteStringOutput@@ -52,20 +69,36 @@ , useHandleOpen , useHandleClose + -- ** Create your own stream spec+ , mkStreamSpec+ , mkPipeStreamSpec++ -- | #launchaprocess#+ -- * Launch a process+ , runProcess+ , readProcess+ , readProcessStdout+ , readProcessStderr+ , readProcessInterleaved+ , withProcessWait+ , withProcessTerm , startProcess , stopProcess- , withProcess- , withProcess_- , readProcess- , readProcess_- , runProcess+ -- ** Exception-throwing functions+ -- | The functions ending in underbar (@_@) are the same as+ -- their counterparts without underbar but instead of returning+ -- an 'ExitCode' they throw 'ExitCodeException' on failure. , runProcess_- , readProcessStdout+ , readProcess_ , readProcessStdout_- , readProcessStderr , readProcessStderr_+ , readProcessInterleaved_+ , withProcessWait_+ , withProcessTerm_ + -- | #interactwithaprocess#+ -- * Interact with a process -- ** Process exit code@@ -76,6 +109,9 @@ , checkExitCode , checkExitCodeSTM + -- ** Process ID+ , getPid+ -- ** Process streams , getStdin , getStdout@@ -83,32 +119,35 @@ -- * Exceptions , ExitCodeException (..)+ , exitCodeExceptionWithOutput+ , exitCodeExceptionNoOutput , ByteStringOutputException (..)++ -- * Re-exports+ , ExitCode (..)+ , P.StdStream (..)+ , P.Pid+ -- * Unsafe functions , unsafeProcessHandle+ -- * Deprecated functions+ , withProcess+ , withProcess_ ) where -import qualified Data.ByteString as S-import Data.ByteString.Lazy.Internal (defaultChunkSize)-import Control.Exception (assert, evaluate, throwIO, Exception, SomeException, finally, bracket, onException, catch, try)-import Control.Monad (void)+import Control.Exception hiding (bracket, finally) import Control.Monad.IO.Class import qualified System.Process as P-import Data.Typeable (Typeable)-import System.IO (Handle, hClose)+import System.IO (hClose) import System.IO.Error (isPermissionError) import Control.Concurrent (threadDelay)-import Control.Concurrent.Async (async, cancel, waitCatch)+import Control.Concurrent.Async (asyncWithUnmask, cancel, waitCatch) import Control.Concurrent.STM (newEmptyTMVarIO, atomically, putTMVar, TMVar, readTMVar, tryReadTMVar, STM, tryPutTMVar, throwSTM, catchSTM)-import System.Exit (ExitCode (ExitSuccess))+import System.Exit (ExitCode (ExitSuccess, ExitFailure))+import System.Process.Typed.Internal import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Char8 as L8-import Data.String (IsString (fromString)) import GHC.RTS.Flags (getConcFlags, ctxtSwitchTime)--#if MIN_VERSION_process(1, 4, 0) && !WINDOWS-import System.Posix.Types (GroupID, UserID)-#endif+import Control.Monad.IO.Unlift #if !MIN_VERSION_base(4, 8, 0) import Control.Applicative (Applicative (..), (<$>), (<$))@@ -118,121 +157,12 @@ 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. --+-- To interact with a @Process@ use the functions from the section+-- [Interact with a process](#interactwithaprocess).+-- -- @since 0.1.0.0 data Process stdin stdout stderr = Process { pConfig :: !(ProcessConfig () () ())@@ -246,440 +176,121 @@ 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 }---- | Inherit the working directory from the parent process.------ @since 0.2.2.0-setWorkingDirInherit- :: ProcessConfig stdin stdout stderr- -> ProcessConfig stdin stdout stderr-setWorkingDirInherit pc = pc { pcWorkingDir = Nothing }---- | 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 }---- | Inherit the environment variables from the parent process.------ @since 0.2.2.0-setEnvInherit- :: ProcessConfig stdin stdout stderr- -> ProcessConfig stdin stdout stderr-setEnvInherit pc = pc { pcEnv = Nothing }---- | 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 }---- | Inherit the group from the parent process.------ @since 0.2.2.0-setChildGroupInherit- :: ProcessConfig stdin stdout stderr- -> ProcessConfig stdin stdout stderr-setChildGroupInherit pc = pc { pcChildGroup = Nothing }---- | 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 }---- | Inherit the user from the parent process.------ @since 0.2.2.0-setChildUserInherit- :: ProcessConfig stdin stdout stderr- -> ProcessConfig stdin stdout stderr-setChildUserInherit pc = pc { pcChildUser = Nothing }-#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)- -- | Launch a process based on the given 'ProcessConfig'. You should--- ensure that you close 'stopProcess' on the result. It's usually+-- ensure that you call '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'.+-- 'stopProcess' is called, such as 'withProcessWait'. -- -- @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+ ssStream pcStdin $ \realStdin ->+ ssStream pcStdout $ \realStdout ->+ ssStream pcStderr $ \realStderr -> 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 = realStdin+ , P.std_out = realStdout+ , P.std_err = realStderr+ , 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+ , 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+ , P.child_group = pcChildGroup+ , P.child_user = pcChildUser #endif - }+ } - (minH, moutH, merrH, pHandle) <- P.createProcess_ "startProcess" cp+ (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+ ((pStdin, pStdout, pStderr), pCleanup1) <- runCleanup $ (,,)+ <$> ssCreate pcStdin pConfig minH+ <*> ssCreate pcStdout pConfig moutH+ <*> ssCreate pcStderr pConfig merrH - pExitCode <- newEmptyTMVarIO- waitingThread <- async $ do- ec <-- if multiThreadedRuntime- then P.waitForProcess pHandle- else do- switchTime <- (fromIntegral . (`div` 1000) . ctxtSwitchTime)- <$> getConcFlags- let minDelay = 1- maxDelay = max minDelay switchTime- loop delay = do- threadDelay delay- mec <- P.getProcessExitCode pHandle- case mec of- Nothing -> loop $ min maxDelay (delay * 2)- Just ec -> pure ec- loop minDelay- atomically $ putTMVar pExitCode ec- return ec+ pExitCode <- newEmptyTMVarIO+ waitingThread <- asyncWithUnmask $ \unmask -> do+ ec <- unmask $ -- make sure the masking state from a bracket isn't inherited+ if multiThreadedRuntime+ then P.waitForProcess pHandle+ else do+ switchTime <- fromIntegral . (`div` 1000) . ctxtSwitchTime+ <$> getConcFlags+ let minDelay = 1+ maxDelay = max minDelay switchTime+ loop delay = do+ threadDelay delay+ mec <- P.getProcessExitCode pHandle+ case mec of+ Nothing -> loop $ min maxDelay (delay * 2)+ Just ec -> pure ec+ loop minDelay+ 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+ 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+ -- Now check if the process had already exited+ eec <- waitCatch waitingThread - case eec of- -- Process already exited, nothing to do- Right _ec -> return ()+ 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- eres <- try $ P.terminateProcess pHandle- ec <-- case eres of- Left e- -- On Windows, with the single-threaded runtime, it- -- seems that if a process has already exited, the- -- call to terminateProcess will fail with a- -- permission denied error. To work around this, we- -- catch this exception and then immediately- -- waitForProcess. There's a chance that there may be- -- other reasons for this permission error to appear,- -- in which case this code may allow us to wait too- -- long for a child process instead of erroring out.- -- Recommendation: always use the multi-threaded- -- runtime!- | isPermissionError e && not multiThreadedRuntime && isWindows ->- P.waitForProcess pHandle- | otherwise -> throwIO e- Right () -> P.waitForProcess pHandle- success <- atomically $ tryPutTMVar pExitCode ec- evaluate $ assert success ()+ -- Process didn't exit yet, let's terminate it and+ -- then call waitForProcess ourselves+ Left _ -> do+ terminateProcess pHandle+ ec <- P.waitForProcess pHandle+ success <- atomically $ tryPutTMVar pExitCode ec+ evaluate $ assert success () - return Process {..}+ return Process {..} where pConfig = clearStreams pConfig' + terminateProcess pHandle = do+ eres <- try $ P.terminateProcess pHandle+ case eres of+ Left e+ -- On Windows, with the single-threaded runtime, it+ -- seems that if a process has already exited, the+ -- call to terminateProcess will fail with a+ -- permission denied error. To work around this, we+ -- catch this exception and then immediately+ -- waitForProcess. There's a chance that there may be+ -- other reasons for this permission error to appear,+ -- in which case this code may allow us to wait too+ -- long for a child process instead of erroring out.+ -- Recommendation: always use the multi-threaded+ -- runtime!+ | isPermissionError e && not multiThreadedRuntime && isWindows ->+ pure ()+ | otherwise -> throwIO e+ Right () -> pure ()+ foreign import ccall unsafe "rtsSupportsBoundThreads" multiThreadedRuntime :: Bool @@ -705,28 +316,90 @@ -- | Uses the bracket pattern to call 'startProcess' and ensures that -- 'stopProcess' is called. ----- In version 0.2.0.0, this function was monomorphized to @IO@ to--- avoid a dependency on the exceptions package.+-- This function is usually /not/ what you want. You're likely better+-- off using 'withProcessWait'. See+-- <https://github.com/fpco/typed-process/issues/25>. ----- @since 0.1.0.0-withProcess :: ProcessConfig stdin stdout stderr- -> (Process stdin stdout stderr -> IO a)- -> IO a-withProcess config = bracket (startProcess config) stopProcess+-- @since 0.2.5.0+withProcessTerm :: (MonadUnliftIO m)+ => ProcessConfig stdin stdout stderr+ -- ^ + -> (Process stdin stdout stderr -> m a)+ -- ^ + -> m a+withProcessTerm config = bracket (startProcess config) stopProcess --- | Same as 'withProcess', but also calls 'checkExitCode'+-- | Uses the bracket pattern to call 'startProcess'. Unlike+-- 'withProcessTerm', this function will wait for the child process to+-- exit, and only kill it with 'stopProcess' in the event that the+-- inner function throws an exception. ----- In version 0.2.0.0, this function was monomorphized to @IO@ to--- avoid a dependency on the exceptions package.+-- To interact with a @Process@ use the functions from the section+-- [Interact with a process](#interactwithaprocess). --+-- @since 0.2.5.0+withProcessWait :: (MonadUnliftIO m)+ => ProcessConfig stdin stdout stderr+ -- ^ + -> (Process stdin stdout stderr -> m a)+ -- ^ + -> m a+withProcessWait config f =+ bracket+ (startProcess config)+ stopProcess+ (\p -> f p <* waitExitCode p)++-- | Deprecated synonym for 'withProcessTerm'.+-- -- @since 0.1.0.0-withProcess_ :: ProcessConfig stdin stdout stderr- -> (Process stdin stdout stderr -> IO a)- -> IO a-withProcess_ config = bracket+withProcess :: (MonadUnliftIO m)+ => ProcessConfig stdin stdout stderr+ -> (Process stdin stdout stderr -> m a)+ -> m a+withProcess = withProcessTerm+{-# DEPRECATED withProcess "Please consider using `withProcessWait`, or instead use `withProcessTerm`" #-}++-- | Same as 'withProcessTerm', but also calls 'checkExitCode'+--+-- To interact with a @Process@ use the functions from the section+-- [Interact with a process](#interactwithaprocess).+--+-- @since 0.2.5.0+withProcessTerm_ :: (MonadUnliftIO m)+ => ProcessConfig stdin stdout stderr+ -- ^ + -> (Process stdin stdout stderr -> m a)+ -- ^ + -> m a+withProcessTerm_ config = bracket (startProcess config) (\p -> stopProcess p `finally` checkExitCode p) +-- | Same as 'withProcessWait', but also calls 'checkExitCode'+--+-- @since 0.2.5.0+withProcessWait_ :: (MonadUnliftIO m)+ => ProcessConfig stdin stdout stderr+ -- ^ + -> (Process stdin stdout stderr -> m a)+ -- ^ + -> m a+withProcessWait_ config f = bracket+ (startProcess config)+ stopProcess+ (\p -> f p <* checkExitCode p)++-- | Deprecated synonym for 'withProcessTerm_'.+--+-- @since 0.1.0.0+withProcess_ :: (MonadUnliftIO m)+ => ProcessConfig stdin stdout stderr+ -> (Process stdin stdout stderr -> m a)+ -> m a+withProcess_ = withProcessTerm_+{-# DEPRECATED withProcess_ "Please consider using `withProcessWait_`, or instead use `withProcessTerm_`" #-}+ -- | 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.@@ -737,6 +410,7 @@ -- @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 $ (,,)@@ -750,9 +424,12 @@ -- | Same as 'readProcess', but instead of returning the 'ExitCode', -- checks it with 'checkExitCode'. --+-- Exceptions thrown by this function will include stdout and stderr.+-- -- @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@@ -773,6 +450,7 @@ readProcessStdout :: MonadIO m => ProcessConfig stdin stdoutIgnored stderr+ -- ^ -> m (ExitCode, L.ByteString) readProcessStdout pc = liftIO $ withProcess pc' $ \p -> atomically $ (,)@@ -784,10 +462,13 @@ -- | Same as 'readProcessStdout', but instead of returning the -- 'ExitCode', checks it with 'checkExitCode'. --+-- Exceptions thrown by this function will include stdout.+-- -- @since 0.2.1.0 readProcessStdout_ :: MonadIO m => ProcessConfig stdin stdoutIgnored stderr+ -- ^ -> m L.ByteString readProcessStdout_ pc = liftIO $ withProcess pc' $ \p -> atomically $ do@@ -799,12 +480,14 @@ where pc' = setStdout byteStringOutput pc --- | Same as 'readProcess', but only read the stderr of the process. Original settings for stderr remain.+-- | Same as 'readProcess', but only read the stderr of the process.+-- Original settings for stdout remain. -- -- @since 0.2.1.0 readProcessStderr :: MonadIO m- => ProcessConfig stdin stderrIgnored stderr+ => ProcessConfig stdin stdout stderrIgnored+ -- ^ -> m (ExitCode, L.ByteString) readProcessStderr pc = liftIO $ withProcess pc' $ \p -> atomically $ (,)@@ -816,10 +499,13 @@ -- | Same as 'readProcessStderr', but instead of returning the -- 'ExitCode', checks it with 'checkExitCode'. --+-- Exceptions thrown by this function will include stderr.+-- -- @since 0.2.1.0 readProcessStderr_ :: MonadIO m- => ProcessConfig stdin stderrIgnored stderr+ => ProcessConfig stdin stdout stderrIgnored+ -- ^ -> m L.ByteString readProcessStderr_ pc = liftIO $ withProcess pc' $ \p -> atomically $ do@@ -831,13 +517,75 @@ where pc' = setStderr byteStringOutput pc +withProcessInterleave :: (MonadUnliftIO m)+ => ProcessConfig stdin stdoutIgnored stderrIgnored+ -- ^ + -> (Process stdin (STM L.ByteString) () -> m a)+ -- ^ + -> m a+withProcessInterleave pc inner =+ -- Create a pipe to be shared for both stdout and stderr+ bracket P.createPipe (\(r, w) -> hClose r >> hClose w) $ \(readEnd, writeEnd) -> do+ -- Use the writer end of the pipe for both stdout and stderr. For+ -- the stdout half, use byteStringFromHandle to read the data into+ -- a lazy ByteString in memory.+ let pc' = setStdout (mkStreamSpec (P.UseHandle writeEnd) (\pc'' _ -> byteStringFromHandle pc'' readEnd))+ $ setStderr (useHandleOpen writeEnd)+ pc+ withProcess pc' $ \p -> do+ -- Now that the process is forked, close the writer end of this+ -- pipe, otherwise the reader end will never give an EOF.+ liftIO $ hClose writeEnd+ inner p++-- | Same as 'readProcess', but interleaves stderr with stdout.+--+-- Motivation: Use this function if you need stdout interleaved with stderr+-- output (e.g. from an HTTP server) in order to debug failures.+--+-- @since 0.2.4.0+readProcessInterleaved+ :: MonadIO m+ => ProcessConfig stdin stdoutIgnored stderrIgnored+ -- ^ + -> m (ExitCode, L.ByteString)+readProcessInterleaved pc =+ liftIO $+ withProcessInterleave pc $ \p ->+ atomically $ (,)+ <$> waitExitCodeSTM p+ <*> getStdout p++-- | Same as 'readProcessInterleaved', but instead of returning the 'ExitCode',+-- checks it with 'checkExitCode'.+--+-- Exceptions thrown by this function will include stdout.+--+-- @since 0.2.4.0+readProcessInterleaved_+ :: MonadIO m+ => ProcessConfig stdin stdoutIgnored stderrIgnored+ -- ^ + -> m L.ByteString+ -- ^ +readProcessInterleaved_ pc =+ liftIO $+ withProcessInterleave pc $ \p -> atomically $ do+ stdout' <- getStdout p+ checkExitCodeSTM p `catchSTM` \ece -> throwSTM ece+ { eceStdout = stdout'+ }+ return stdout'+ -- | 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 instead of returning the@@ -846,6 +594,7 @@ -- @since 0.1.0.0 runProcess_ :: MonadIO m => ProcessConfig stdin stdout stderr+ -- ^ -> m () runProcess_ pc = liftIO $ withProcess pc checkExitCode @@ -876,6 +625,9 @@ -- | Wait for a process to exit, and ensure that it exited -- successfully. If not, throws an 'ExitCodeException'. --+-- Exceptions thrown by this function will not include stdout or stderr (This prevents unbounded memory usage from reading them into memory).+-- However, some callers such as 'readProcess_' catch the exception, add the stdout and stderr, and rethrow.+-- -- @since 0.1.0.0 checkExitCode :: MonadIO m => Process stdin stdout stderr -> m () checkExitCode = liftIO . atomically . checkExitCodeSTM@@ -888,13 +640,19 @@ ec <- readTMVar (pExitCode p) case ec of ExitSuccess -> return ()- _ -> throwSTM ExitCodeException- { eceExitCode = ec- , eceProcessConfig = clearStreams (pConfig p)- , eceStdout = L.empty- , eceStderr = L.empty- }+ _ -> throwSTM $ exitCodeExceptionNoOutput p ec +-- | Returns the PID (process ID) of a subprocess.+--+-- 'Nothing' is returned if the underlying 'P.ProcessHandle' was already closed.+-- Otherwise a PID is returned that remains valid as long as the handle is+-- open. The operating system may reuse the PID as soon as the last handle to+-- the process is closed.+--+-- @since 0.2.12.0+getPid :: Process stdin stdout stderr -> IO (Maybe P.Pid)+getPid = P.getPid . pHandle+ -- | Internal clearStreams :: ProcessConfig stdin stdout stderr -> ProcessConfig () () () clearStreams pc = pc@@ -921,42 +679,17 @@ 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_'.+-- | Get a process's configuration. ----- @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"- -- Too much output for an exception if we show the modified- -- environment, so hide it- , show (eceProcessConfig ece) { pcEnv = Nothing }- , 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'.+-- This is useful for constructing 'ExitCodeException's. ----- @since 0.1.0.0-data ByteStringOutputException = ByteStringOutputException SomeException (ProcessConfig () () ())- deriving (Show, Typeable)-instance Exception ByteStringOutputException+-- Note that the stdin, stdout, and stderr streams are stored in the 'Process',+-- not the 'ProcessConfig', so the returned 'ProcessConfig' will always have+-- empty stdin, stdout, and stderr values.+--+-- @since 0.2.12.0+getProcessConfig :: Process stdin stdout stderr -> ProcessConfig () () ()+getProcessConfig = pConfig -- | Take 'System.Process.ProcessHandle' out of the 'Process'. -- This method is needed in cases one need to use low level functions@@ -969,7 +702,7 @@ -- This method is considered unsafe because the actions it performs on -- the underlying process may overlap with the functionality that -- @typed-process@ provides. For example the user should not call--- 'System.Process.waitForProcess' on the process handle as eiter+-- 'System.Process.waitForProcess' on the process handle as either -- 'System.Process.waitForProcess' or 'stopProcess' will lock. -- Additionally, even if process was terminated by the -- 'System.Process.terminateProcess' or by sending signal,@@ -979,3 +712,45 @@ -- @since 0.1.1 unsafeProcessHandle :: Process stdin stdout stderr -> P.ProcessHandle unsafeProcessHandle = pHandle++-- | Get an 'ExitCodeException' containing the process's stdout and stderr data.+--+-- Note that this will call 'waitExitCode' to block until the process exits, if+-- it has not exited already.+--+-- Unlike 'checkExitCode' and similar, this will return an 'ExitCodeException'+-- even if the process exits with 'ExitSuccess'.+--+-- @since 0.2.12.0+exitCodeExceptionWithOutput :: MonadIO m+ => Process stdin (STM L.ByteString) (STM L.ByteString)+ -> m ExitCodeException+exitCodeExceptionWithOutput process = liftIO $ atomically $ do+ exitCode <- waitExitCodeSTM process+ stdout <- getStdout process+ stderr <- getStderr process+ pure ExitCodeException+ { eceExitCode = exitCode+ , eceProcessConfig = pConfig process+ , eceStdout = stdout+ , eceStderr = stderr+ }++-- | Get an 'ExitCodeException' containing no data other than the exit code and+-- process config.+--+-- Unlike 'checkExitCode' and similar, this will return an 'ExitCodeException'+-- even if the process exits with 'ExitSuccess'.+--+-- @since 0.2.12.0+exitCodeExceptionNoOutput :: Process stdin stdout stderr+ -> ExitCode+ -> ExitCodeException+exitCodeExceptionNoOutput process exitCode =+ ExitCodeException+ { eceExitCode = exitCode+ , eceProcessConfig = pConfig process+ , eceStdout = L.empty+ , eceStderr = L.empty+ }+
+ src/System/Process/Typed/Internal.hs view
@@ -0,0 +1,655 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | This module is __internal__ and its contents may change without a warning+-- or announcement. It is not subject to the PVP.+module System.Process.Typed.Internal where++import qualified Data.ByteString as S+import Data.ByteString.Lazy.Internal (defaultChunkSize)+import qualified Control.Exception as E+import Control.Exception hiding (bracket, finally, handle)+import Control.Monad (void)+import qualified System.Process as P+import Data.Typeable (Typeable)+import System.IO (Handle, hClose, IOMode(ReadWriteMode), withBinaryFile)+import Control.Concurrent.Async (async)+import Control.Concurrent.STM (newEmptyTMVarIO, atomically, putTMVar, readTMVar, STM, tryPutTMVar, throwSTM)+import System.Exit (ExitCode)+import qualified Data.ByteString.Lazy as L+import Data.String (IsString (fromString))+import Control.Monad.IO.Unlift+import qualified Data.Text.Encoding.Error as TEE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE++#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](#processconfigsetters) for default values.+--+-- Once you have a @ProcessConfig@ you can launch a process from it+-- using the functions in the section [Launch a+-- process](#launchaprocess).+--+-- @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+ | 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, @stdin@, @stdout@ and @stderr@. A 'StreamSpec' can be+-- thought of as containing+--+-- 1. A type safe version of 'P.StdStream' from "System.Process".+-- This determines whether the stream should be inherited from the+-- parent process, piped to or from a 'Handle', etc.+--+-- 2. A means of accessing the stream as a value of type @a@+--+-- 3. A cleanup action which will be run on the stream once the+-- process terminates+--+-- To create a @StreamSpec@ see the section [Stream+-- specs](#streamspecs).+--+-- @since 0.1.0.0+data StreamSpec (streamType :: StreamType) a = StreamSpec+ { ssStream :: !(forall b. (P.StdStream -> IO b) -> IO b)+ , 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)++-- | 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 }++-- | Inherit the working directory from the parent process.+--+-- @since 0.2.2.0+setWorkingDirInherit+ :: ProcessConfig stdin stdout stderr+ -- ^ + -> ProcessConfig stdin stdout stderr+setWorkingDirInherit pc = pc { pcWorkingDir = Nothing }++-- | 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 }++-- | Inherit the environment variables from the parent process.+--+-- @since 0.2.2.0+setEnvInherit+ :: ProcessConfig stdin stdout stderr+ -- ^ + -> ProcessConfig stdin stdout stderr+setEnvInherit pc = pc { pcEnv = Nothing }++-- | 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 }++-- | Inherit the group from the parent process.+--+-- @since 0.2.2.0+setChildGroupInherit+ :: ProcessConfig stdin stdout stderr+ -- ^ + -> ProcessConfig stdin stdout stderr+setChildGroupInherit pc = pc { pcChildGroup = Nothing }++-- | 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 }++-- | Inherit the user from the parent process.+--+-- @since 0.2.2.0+setChildUserInherit+ :: ProcessConfig stdin stdout stderr+ -- ^ + -> ProcessConfig stdin stdout stderr+setChildUserInherit pc = pc { pcChildUser = Nothing }+#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. The handle will be @Just@ 'Handle' if the+-- 'P.StdStream' argument is 'P.CreatePipe' and @Nothing@ otherwise.+-- See 'P.createProcess' for more details.+--+-- * Returns the actual stream value @a@, as well as a cleanup+-- function to be run when calling 'stopProcess'.+--+-- If making a 'StreamSpec' with 'P.CreatePipe', prefer 'mkPipeStreamSpec',+-- which encodes the invariant that a 'Handle' is created.+--+-- @since 0.1.0.0+mkStreamSpec :: P.StdStream+ -- ^ + -> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))+ -- ^ + -> StreamSpec streamType a+mkStreamSpec ss f = mkManagedStreamSpec ($ ss) f++-- | Create a new 'P.CreatePipe' 'StreamSpec' from the given function.+-- This function:+--+-- * Takes as input the @Handle@ returned by the 'P.createProcess' function.+-- See 'P.createProcess' for more details.+--+-- * Returns the actual stream value @a@, as well as a cleanup+-- function to be run when calling 'stopProcess'.+--+-- @since 0.2.10.0+mkPipeStreamSpec :: (ProcessConfig () () () -> Handle -> IO (a, IO ()))+ -- ^ + -> StreamSpec streamType a+ -- ^ +mkPipeStreamSpec f = mkStreamSpec P.CreatePipe $ \pc mh ->+ case mh of+ Just h -> f pc h+ Nothing -> error "Invariant violation: making StreamSpec with CreatePipe unexpectedly did not return a Handle"++-- | Create a new 'StreamSpec' from a function that accepts a+-- 'P.StdStream' and a helper function. This function is the same as+-- the helper in 'mkStreamSpec'+mkManagedStreamSpec :: (forall b. (P.StdStream -> IO b) -> IO b)+ -- ^ + -> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ()))+ -- ^ + -> StreamSpec streamType a+mkManagedStreamSpec 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 (\_ _ -> pure ((), return ()))++-- | A stream spec which is empty when used for for input and discards+-- output. Note this requires your platform's null device to be+-- available when the process is started.+--+-- @since 0.2.5.0+nullStream :: StreamSpec anyStreamType ()+nullStream = mkManagedStreamSpec opener cleanup+ where+ opener f =+ withBinaryFile nullDevice ReadWriteMode $ \handle ->+ f (P.UseHandle handle)+ cleanup _ _ =+ pure ((), return ())++-- | A stream spec which will close the stream for the child process.+-- You usually do not want to use this, as it will leave the+-- corresponding file descriptor unassigned and hence available for+-- re-use in the child process. Prefer 'nullStream' unless you're+-- certain you want this behavior.+--+-- @since 0.1.0.0+closed :: StreamSpec anyStreamType ()+#if MIN_VERSION_process(1, 4, 0)+closed = mkStreamSpec P.NoStream (\_ _ -> pure ((), return ()))+#else+closed = mkPipeStreamSpec (\_ 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 = mkPipeStreamSpec $ \_ 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 = mkPipeStreamSpec $ \pc h -> byteStringFromHandle pc h++-- | Helper function (not exposed) for both 'byteStringOutput' and+-- 'withProcessInterleave'. This will consume all of the output from+-- the given 'Handle' in a separate thread and provide access to the+-- resulting 'L.ByteString' via STM. Second action will close the+-- reader handle.+byteStringFromHandle+ :: ProcessConfig () () ()+ -> Handle -- ^ reader handle+ -> IO (STM L.ByteString, IO ())+byteStringFromHandle pc 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 = mkPipeStreamSpec $ \_ 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) $ \_ _ -> 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) $ \_ _ -> return ((), hClose h)++-- | Exception thrown by 'System.Process.Typed.checkExitCode' in the event of a+-- non-success exit code. Note that 'System.Process.Typed.checkExitCode' is+-- called by other functions as well, like 'System.Process.Typed.runProcess_'+-- or 'System.Process.Typed.readProcess_'.+--+-- Note that several functions that throw an 'ExitCodeException' intentionally do not populate 'eceStdout' or 'eceStderr'.+-- This prevents unbounded memory usage for large stdout and stderrs.+--+-- Functions which do include 'eceStdout' or 'eceStderr' (like+-- 'System.Process.Typed.readProcess_') state so in their documentation.+--+-- @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"+ -- Too much output for an exception if we show the modified+ -- environment, so hide it+ , show (eceProcessConfig ece) { pcEnv = Nothing }+ , if L.null (eceStdout ece)+ then ""+ else "Standard output:\n\n" ++ unpack (eceStdout ece)+ , if L.null (eceStderr ece)+ then ""+ else "Standard error:\n\n" ++ unpack (eceStderr ece)+ ]+ where+ -- Format with UTF-8, because we have to choose some encoding,+ -- and UTF-8 is the least likely to be wrong in general.+ unpack = TL.unpack . TLE.decodeUtf8With TEE.lenientDecode++-- | 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++bracket :: MonadUnliftIO m => IO a -> (a -> IO b) -> (a -> m c) -> m c+bracket before after thing = withRunInIO $ \run -> E.bracket before after (run . thing)++finally :: MonadUnliftIO m => m a -> IO () -> m a+finally thing after = withRunInIO $ \run -> E.finally (run thing) after++-- | The name of the system null device+nullDevice :: FilePath+#if WINDOWS+nullDevice = "\\\\.\\NUL"+#else+nullDevice = "/dev/null"+#endif
test/System/Process/TypedSpec.hs view
@@ -3,6 +3,7 @@ module System.Process.TypedSpec (spec) where import System.Process.Typed+import System.Process.Typed.Internal import System.IO import Control.Concurrent.Async (Concurrently (..)) import Control.Concurrent.STM (atomically)@@ -21,12 +22,36 @@ spec :: Spec spec = do+ -- This is mainly to make sure we use the right device filename on Windows+ it "Null device is accessible" $ do+ withBinaryFile nullDevice WriteMode $ \fp -> do+ hPutStrLn fp "Hello world"+ withBinaryFile nullDevice ReadMode $ \fp -> do+ atEnd <- hIsEOF fp+ atEnd `shouldBe` True+ it "bytestring stdin" $ do let bs :: IsString s => s bs = "this is a test" res <- readProcess (setStdin bs "cat") res `shouldBe` (ExitSuccess, bs, "") + it "null stdin" $ do+ res <- readProcess (setStdin nullStream "cat")+ res `shouldBe` (ExitSuccess, "", "")++ it "null stdout" $ do+ -- In particular, writing to that doesn't terminate the process with an error+ bs <- readProcessStderr_ $ setStdout nullStream $ setStdin nullStream $+ proc "sh" ["-c", "echo hello; echo world >&2"]+ bs `shouldBe` "world\n"++ it "null stderr" $ do+ -- In particular, writing to that doesn't terminate the process with an error+ bs <- readProcessStdout_ $ setStderr nullStream $ setStdin nullStream $+ proc "sh" ["-c", "echo hello >&2; echo world"]+ bs `shouldBe` "world\n"+ it "useHandleOpen" $ withSystemTempFile "use-handle-open" $ \fp h -> do let bs :: IsString s => s bs = "this is a test 2"@@ -74,7 +99,7 @@ runProcess_ "false" `shouldThrow` \ExitCodeException{} -> True it "async" $ withSystemTempFile "httpbin" $ \fp h -> do- lbs <- withProcess (setStdin createPipe $ setStdout byteStringOutput "base64") $ \p ->+ lbs <- withProcessWait (setStdin createPipe $ setStdout byteStringOutput "base64") $ \p -> runConcurrently $ Concurrently (do bs <- S.readFile "README.md"@@ -86,3 +111,62 @@ let encoded = S.filter (/= 10) $ L.toStrict lbs raw <- S.readFile fp encoded `shouldBe` B64.encode raw++ describe "withProcessWait" $+ it "succeeds with sleep" $ do+ p <- withProcessWait (proc "sleep" ["1"]) pure+ checkExitCode p :: IO ()++ describe "withProcessWait_" $+ it "succeeds with sleep"+ ((withProcessWait_ (proc "sleep" ["1"]) $ const $ pure ()) :: IO ())++ -- These tests fail on older GHCs/process package versions+ -- because, apparently, waitForProcess isn't interruptible. See+ -- https://github.com/fpco/typed-process/pull/26#issuecomment-505702573.++ {-+ describe "withProcessTerm" $ do+ it "fails with sleep" $ do+ p <- withProcessTerm (proc "sleep" ["1"]) pure+ checkExitCode p `shouldThrow` anyException++ describe "withProcessTerm_" $ do+ it "fails with sleep" $+ withProcessTerm_ (proc "sleep" ["1"]) (const $ pure ())+ `shouldThrow` anyException+ -}++ it "interleaved output" $ withSystemTempFile "interleaved-output" $ \fp h -> do+ S.hPut h "\necho 'stdout'\n>&2 echo 'stderr'\necho 'stdout'"+ hClose h++ let config = proc "sh" [fp]+ -- Assert, that our bash script doesn't send output only to stdout and+ -- we assume that we captured from stderr as well+ onlyErr <- readProcessStderr_ (setStdout createPipe config)+ onlyErr `shouldBe` "stderr\n"++ (res, lbs1) <- readProcessInterleaved config+ res `shouldBe` ExitSuccess+ lbs1 `shouldBe` "stdout\nstderr\nstdout\n"++ lbs2 <- readProcessInterleaved_ config+ lbs1 `shouldBe` lbs2++ it "interleaved output handles large data" $ withSystemTempFile "interleaved-output" $ \fp h -> do+ S.hPut h "\nfor i in {1..4064}; do\necho 'stdout';\n>&2 echo 'stderr';\necho 'stdout';\ndone"+ hClose h++ let config = proc "sh" [fp]+ (result, lbs1) <- readProcessInterleaved config+ result `shouldBe` ExitSuccess+ lbs2 <- readProcessInterleaved_ config+ lbs1 `shouldBe` lbs2++ let expected = "stdout\nstderr\nstdout\n"+ L.take (L.length expected) lbs1 `shouldBe` expected++ it "empty param are showed" $+ let expected = "Raw command: podman exec --detach-keys \"\" ctx bash\n"+ in show (proc "podman" ["exec", "--detach-keys", "", "ctx", "bash"]) `shouldBe` expected
typed-process.cabal view
@@ -1,17 +1,15 @@-cabal-version: >= 1.10+cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.29.0.+-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack------ hash: 8fd30ba42322fffadc01326bcc1370fa86c650057800ca91d5381d89e91df797 name: typed-process-version: 0.2.3.0+version: 0.2.13.0 synopsis: Run external processes, with strong typing of streams-description: Please see the tutorial at <https://haskell-lang.org/library/typed-process>+description: Please see the tutorial at <https://github.com/fpco/typed-process#readme> category: System-homepage: https://haskell-lang.org/library/typed-process+homepage: https://github.com/fpco/typed-process bug-reports: https://github.com/fpco/typed-process/issues author: Michael Snoyman maintainer: michael@snoyman.com@@ -19,8 +17,8 @@ license-file: LICENSE build-type: Simple extra-source-files:- ChangeLog.md README.md+ ChangeLog.md source-repository head type: git@@ -29,20 +27,23 @@ library exposed-modules: System.Process.Typed+ System.Process.Typed.Internal other-modules: Paths_typed_process hs-source-dirs: src build-depends:- async- , base >=4.8 && <5+ async >=2.0+ , base >=4.12 && <5 , bytestring , process >=1.2 , stm+ , text , transformers+ , unliftio-core+ default-language: Haskell2010 if os(windows) cpp-options: -DWINDOWS- default-language: Haskell2010 test-suite typed-process-test type: exitcode-stdio-1.0@@ -53,17 +54,21 @@ hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ hspec-discover:hspec-discover build-depends:- async- , base >=4.8 && <5+ async >=2.0+ , base >=4.12 && <5 , base64-bytestring , bytestring- , hspec+ , hspec ==2.* , process >=1.2 , stm , temporary+ , text , transformers , typed-process+ , unliftio-core default-language: Haskell2010 test-suite typed-process-test-single-threaded@@ -74,15 +79,19 @@ Paths_typed_process hs-source-dirs: test+ build-tool-depends:+ hspec-discover:hspec-discover build-depends:- async- , base >=4.8 && <5+ async >=2.0+ , base >=4.12 && <5 , base64-bytestring , bytestring- , hspec+ , hspec ==2.* , process >=1.2 , stm , temporary+ , text , transformers , typed-process+ , unliftio-core default-language: Haskell2010