typed-process 0.1.1 → 0.2.13.0
raw patch · 6 files changed
Files
- ChangeLog.md +91/−0
- README.md +42/−34
- src/System/Process/Typed.hs +751/−845
- src/System/Process/Typed/Internal.hs +655/−0
- test/System/Process/TypedSpec.hs +94/−13
- typed-process.cabal +91/−45
ChangeLog.md view
@@ -1,3 +1,94 @@+# 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++## 0.2.2.0++* Add inherit versions of setter functions++## 0.2.1.0++* Add `readProcessStdout`, `readProcessStdout_`, `readProcessStderr`, and `readProcessStderr_`+* Do not show modified environment information in exceptions++## 0.2.0.0++* Remove dependency on `conduit` and `conduit-extra`. Relevant code added to+ `Data.Conduit.Process.Typed` in `conduit-extra-1.2.1`.+ ## 0.1.1 * Introduce 'unsafeProcessHandle' function
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@@ -19,11 +19,17 @@ 5. Providing a more composable API, designed to be easy to use for both simple and complex use cases +__NOTE__ It's highly recommended that you compile any program using this+library with the multi-threaded runtime, usually by adding `ghc-options:+-threaded` to your executable stanza in your cabal or `package.yaml` file. The+single-threaded runtime necessitates some inefficient polling to be used under+the surface.+ ## Synopsis ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.IO (hPutStr, hClose) import System.Process.Typed@@ -54,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)@@ -79,14 +85,15 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- 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 () () ())@@ -102,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-7.3 --install-ghc runghc --package typed-process+-- 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 ```@@ -123,7 +130,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -138,8 +145,8 @@ ## Type parameters -Both `ProcessConfig` and `Process` each take three type parameters,-with the type of the standard input, output, and error streams for the+Both `ProcessConfig` and `Process` take three type parameters:+the types 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`@@ -151,7 +158,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -183,7 +190,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -214,7 +221,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -228,7 +235,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -241,12 +248,12 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- 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@@ -259,7 +266,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.Exit (ExitCode)@@ -285,7 +292,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import Data.ByteString.Lazy (ByteString)@@ -306,15 +313,15 @@ 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+[`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-7.3 --install-ghc runghc --package typed-process --package temporary+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed-import System.IO.Temp (withSystemTempFile)+import UnliftIO.Temporary (withSystemTempFile) main :: IO () main = withSystemTempFile "date" $ \fp h -> do@@ -335,11 +342,11 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO (hClose)-import System.IO.Temp (withSystemTempFile)+import UnliftIO.Temporary (withSystemTempFile) import Control.Monad (replicateM_) main :: IO ()@@ -365,7 +372,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -377,7 +384,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed @@ -390,11 +397,11 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO-import System.IO.Temp (withSystemTempFile)+import UnliftIO.Temporary (withSystemTempFile) main :: IO () main = withSystemTempFile "input" $ \fp h -> do@@ -416,7 +423,7 @@ ```haskell #!/usr/bin/env stack--- stack --resolver lts-7.3 --install-ghc runghc --package typed-process+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO@@ -443,13 +450,14 @@ ## 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.+number of other settings you can tweak. It's best to just+[look at the API docs](https://www.stackage.org/package/typed-process)+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+-- stack --resolver lts-16.27 script {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed
src/System/Process/Typed.hs view
@@ -3,848 +3,754 @@ {-# 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 (..)- -- * Unsafe functions- , unsafeProcessHandle- ) where--import qualified Data.ByteString as S-import Data.ByteString.Lazy.Internal (defaultChunkSize)-import Control.Exception (assert, evaluate, 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- ec <- P.waitForProcess pHandle- success <- atomically $ tryPutTMVar pExitCode ec- evaluate $ assert success ()-- 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---- | Take 'System.Process.ProcessHandle' out of the 'Process'.--- This method is needed in cases one need to use low level functions--- from the @process@ package. Use cases for this method are:------ 1. Send a special signal to the process.--- 2. Terminate the process group instead of terminating single process.--- 3. Use platform specific API on the underlying process.------ 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' or 'stopProcess' will lock.--- Additionally, even if process was terminated by the--- 'System.Process.terminateProcess' or by sending signal,--- 'stopProcess' should be called either way in order to cleanup resources--- allocated by the @typed-process@.------ @since 0.1.1-unsafeProcessHandle :: Process stdin stdout stderr -> P.ProcessHandle-unsafeProcessHandle = pHandle+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | 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+ , StreamSpec+ , StreamType (..)+ , Process++ -- * ProcessConfig+ -- ** Smart constructors+ , proc+ , shell++ -- | #processconfigsetters#++ -- ** Setters+ , setStdin+ , setStdout+ , setStderr+ , setWorkingDir+ , setWorkingDirInherit+ , setEnv+ , setEnvInherit+ , setCloseFds+ , setCreateGroup+ , setDelegateCtlc+#if MIN_VERSION_process(1, 3, 0)+ , setDetachConsole+ , setCreateNewConsole+ , setNewSession+#endif+#if MIN_VERSION_process(1, 4, 0) && !WINDOWS+ , setChildGroup+ , setChildGroupInherit+ , setChildUser+ , setChildUserInherit+#endif++ -- | #streamspecs#++ -- * Stream specs+ -- ** Built-in stream specs+ , inherit+ , nullStream+ , closed+ , byteStringInput+ , byteStringOutput+ , createPipe+ , useHandleOpen+ , useHandleClose++ -- ** Create your own stream spec+ , mkStreamSpec+ , mkPipeStreamSpec++ -- | #launchaprocess#++ -- * Launch a process+ , runProcess+ , readProcess+ , readProcessStdout+ , readProcessStderr+ , readProcessInterleaved+ , withProcessWait+ , withProcessTerm+ , startProcess+ , stopProcess+ -- ** 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_+ , readProcess_+ , readProcessStdout_+ , readProcessStderr_+ , readProcessInterleaved_+ , withProcessWait_+ , withProcessTerm_++ -- | #interactwithaprocess#++ -- * Interact with a process++ -- ** Process exit code+ , waitExitCode+ , waitExitCodeSTM+ , getExitCode+ , getExitCodeSTM+ , checkExitCode+ , checkExitCodeSTM++ -- ** Process ID+ , getPid++ -- ** Process streams+ , getStdin+ , getStdout+ , getStderr++ -- * Exceptions+ , ExitCodeException (..)+ , exitCodeExceptionWithOutput+ , exitCodeExceptionNoOutput+ , ByteStringOutputException (..)++ -- * Re-exports+ , ExitCode (..)+ , P.StdStream (..)+ , P.Pid++ -- * Unsafe functions+ , unsafeProcessHandle+ -- * Deprecated functions+ , withProcess+ , withProcess_+ ) where++import Control.Exception hiding (bracket, finally)+import Control.Monad.IO.Class+import qualified System.Process as P+import System.IO (hClose)+import System.IO.Error (isPermissionError)+import Control.Concurrent (threadDelay)+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, ExitFailure))+import System.Process.Typed.Internal+import qualified Data.ByteString.Lazy as L+import GHC.RTS.Flags (getConcFlags, ctxtSwitchTime)+import Control.Monad.IO.Unlift++#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++-- | 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 () () ())+ , 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)++-- | Launch a process based on the given 'ProcessConfig'. You should+-- 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 'withProcessWait'.+--+-- @since 0.1.0.0+startProcess :: MonadIO m+ => ProcessConfig stdin stdout stderr+ -- ^ + -> m (Process stdin stdout stderr)+startProcess pConfig'@ProcessConfig {..} = liftIO $ do+ 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+#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 <- 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++ -- 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+ terminateProcess pHandle+ ec <- P.waitForProcess pHandle+ success <- atomically $ tryPutTMVar pExitCode ec+ evaluate $ assert success ()++ 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++isWindows :: Bool+#if WINDOWS+isWindows = True+#else+isWindows = False+#endif++-- | 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++-- | Uses the bracket pattern to call 'startProcess' and ensures that+-- 'stopProcess' is called.+--+-- 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.2.5.0+withProcessTerm :: (MonadUnliftIO m)+ => ProcessConfig stdin stdout stderr+ -- ^ + -> (Process stdin stdout stderr -> m a)+ -- ^ + -> m a+withProcessTerm config = bracket (startProcess config) stopProcess++-- | 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.+--+-- 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 :: (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.+--+-- 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'.+--+-- 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+ 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++-- | Same as 'readProcess', but only read the stdout of the process. Original settings for stderr remain.+--+-- @since 0.2.1.0+readProcessStdout+ :: MonadIO m+ => ProcessConfig stdin stdoutIgnored stderr+ -- ^ + -> m (ExitCode, L.ByteString)+readProcessStdout pc =+ liftIO $ withProcess pc' $ \p -> atomically $ (,)+ <$> waitExitCodeSTM p+ <*> getStdout p+ where+ pc' = setStdout byteStringOutput pc++-- | 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+ stdout <- getStdout p+ checkExitCodeSTM p `catchSTM` \ece -> throwSTM ece+ { eceStdout = stdout+ }+ return stdout+ where+ pc' = setStdout byteStringOutput pc++-- | 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 stdout stderrIgnored+ -- ^ + -> m (ExitCode, L.ByteString)+readProcessStderr pc =+ liftIO $ withProcess pc' $ \p -> atomically $ (,)+ <$> waitExitCodeSTM p+ <*> getStderr p+ where+ pc' = setStderr byteStringOutput pc++-- | 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 stdout stderrIgnored+ -- ^ + -> m L.ByteString+readProcessStderr_ pc =+ liftIO $ withProcess pc' $ \p -> atomically $ do+ stderr <- getStderr p+ checkExitCodeSTM p `catchSTM` \ece -> throwSTM ece+ { eceStderr = stderr+ }+ return stderr+ 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+-- 'ExitCode', checks it with 'checkExitCode'.+--+-- @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'.+--+-- 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++-- | 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 $ 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+ { 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++-- | Get a process's configuration.+--+-- This is useful for constructing 'ExitCodeException's.+--+-- 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+-- from the @process@ package. Use cases for this method are:+--+-- 1. Send a special signal to the process.+-- 2. Terminate the process group instead of terminating single process.+-- 3. Use platform specific API on the underlying process.+--+-- 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 either+-- 'System.Process.waitForProcess' or 'stopProcess' will lock.+-- Additionally, even if process was terminated by the+-- 'System.Process.terminateProcess' or by sending signal,+-- 'stopProcess' should be called either way in order to cleanup resources+-- allocated by the @typed-process@.+--+-- @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,18 +3,17 @@ module System.Process.TypedSpec (spec) where import System.Process.Typed+import System.Process.Typed.Internal import System.IO-import Data.Conduit-import qualified Data.Conduit.Binary as CB-import Network.HTTP.Simple import Control.Concurrent.Async (Concurrently (..))+import Control.Concurrent.STM (atomically) import Test.Hspec import System.Exit import System.IO.Temp import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L 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)@@ -23,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"@@ -76,16 +99,74 @@ runProcess_ "false" `shouldThrow` \ExitCodeException{} -> True it "async" $ withSystemTempFile "httpbin" $ \fp h -> do- bss <- withProcess (setStdin createSink $ setStdout createSource "base64") $ \p ->+ lbs <- withProcessWait (setStdin createPipe $ setStdout byteStringOutput "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)+ Concurrently (do+ bs <- S.readFile "README.md"+ S.hPut h bs+ S.hPut (getStdin p) bs+ hClose (getStdin p)) *>+ Concurrently (atomically $ getStdout p) hClose h- let encoded = S.filter (/= 10) $ S.concat bss+ 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,51 +1,97 @@-name: typed-process-version: 0.1.1-synopsis: Run external processes, with strong typing of streams-description: Please see README.md-homepage: https://haskell-lang.org/library/typed-process-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+cabal-version: 1.12 +-- This file has been generated from package.yaml by hpack version 0.38.0.+--+-- see: https://github.com/sol/hpack++name: typed-process+version: 0.2.13.0+synopsis: Run external processes, with strong typing of streams+description: Please see the tutorial at <https://github.com/fpco/typed-process#readme>+category: System+homepage: https://github.com/fpco/typed-process+bug-reports: https://github.com/fpco/typed-process/issues+author: Michael Snoyman+maintainer: michael@snoyman.com+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/fpco/typed-process+ 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+ exposed-modules:+ System.Process.Typed+ System.Process.Typed.Internal+ other-modules:+ Paths_typed_process+ hs-source-dirs:+ src+ build-depends:+ 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+ cpp-options: -DWINDOWS 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+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ System.Process.TypedSpec+ Paths_typed_process+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ async >=2.0+ , base >=4.12 && <5+ , base64-bytestring+ , bytestring+ , hspec ==2.*+ , process >=1.2+ , stm+ , temporary+ , text+ , transformers+ , typed-process+ , unliftio-core+ default-language: Haskell2010 -source-repository head- type: git- location: https://github.com/fpco/typed-process+test-suite typed-process-test-single-threaded+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ System.Process.TypedSpec+ Paths_typed_process+ hs-source-dirs:+ test+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ async >=2.0+ , base >=4.12 && <5+ , base64-bytestring+ , bytestring+ , hspec ==2.*+ , process >=1.2+ , stm+ , temporary+ , text+ , transformers+ , typed-process+ , unliftio-core+ default-language: Haskell2010