typed-process-0.1.1/src/0000755000000000000000000000000013000114420013250 5ustar0000000000000000typed-process-0.1.1/src/System/0000755000000000000000000000000013000114420014534 5ustar0000000000000000typed-process-0.1.1/src/System/Process/0000755000000000000000000000000013147016223016170 5ustar0000000000000000typed-process-0.1.1/test/0000755000000000000000000000000013000114513013443 5ustar0000000000000000typed-process-0.1.1/test/System/0000755000000000000000000000000013000114513014727 5ustar0000000000000000typed-process-0.1.1/test/System/Process/0000755000000000000000000000000013142046313016356 5ustar0000000000000000typed-process-0.1.1/src/System/Process/Typed.hs0000644000000000000000000006371713147016223017627 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Please see the README.md file for examples of using this API. module System.Process.Typed ( -- * Types ProcessConfig , StreamSpec , StreamType (..) , Process -- * ProcessConfig -- ** Smart constructors , proc , shell -- ** Setters , setStdin , setStdout , setStderr , setWorkingDir , setEnv , setCloseFds , setCreateGroup , setDelegateCtlc #if MIN_VERSION_process(1, 3, 0) , setDetachConsole , setCreateNewConsole , setNewSession #endif #if MIN_VERSION_process(1, 4, 0) && !WINDOWS , setChildGroup , setChildUser #endif -- * Stream specs , mkStreamSpec , inherit , closed , byteStringInput , byteStringOutput , createPipe , useHandleOpen , useHandleClose -- ** Conduit , createSink , createSource -- * Launch a process , startProcess , stopProcess , withProcess , withProcess_ , readProcess , readProcess_ , runProcess , runProcess_ -- * Interact with a process -- ** Process exit code , waitExitCode , waitExitCodeSTM , getExitCode , getExitCodeSTM , checkExitCode , checkExitCodeSTM -- ** Process streams , getStdin , getStdout , getStderr -- * Exceptions , ExitCodeException (..) , ByteStringOutputException (..) -- * 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 typed-process-0.1.1/test/Spec.hs0000644000000000000000000000005413000114507014673 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} typed-process-0.1.1/test/System/Process/TypedSpec.hs0000644000000000000000000000572613142046313020624 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module System.Process.TypedSpec (spec) where import System.Process.Typed import System.IO import Data.Conduit import qualified Data.Conduit.Binary as CB import Network.HTTP.Simple import Control.Concurrent.Async (Concurrently (..)) import Test.Hspec import System.Exit import System.IO.Temp import qualified Data.ByteString as S import Data.String (IsString) import Data.Monoid ((<>)) import qualified Data.Conduit.List as CL import qualified Data.ByteString.Base64 as B64 #if !MIN_VERSION_base(4, 8, 0) import Control.Applicative ((*>)) #endif spec :: Spec spec = do it "bytestring stdin" $ do let bs :: IsString s => s bs = "this is a test" res <- readProcess (setStdin bs "cat") res `shouldBe` (ExitSuccess, bs, "") it "useHandleOpen" $ withSystemTempFile "use-handle-open" $ \fp h -> do let bs :: IsString s => s bs = "this is a test 2" S.hPut h bs hClose h res <- withBinaryFile fp ReadMode $ \h' -> do res <- readProcess (setStdin (useHandleOpen h') "cat") isOpen <- hIsOpen h' isOpen `shouldBe` True return res res `shouldBe` (ExitSuccess, bs, "") it "useHandleClose" $ withSystemTempFile "use-handle-close" $ \fp h -> do let bs :: IsString s => s bs = "this is a test 3" S.hPut h bs hClose h res <- withBinaryFile fp ReadMode $ \h' -> do res <- readProcess (setStdin (useHandleClose h') "cat") isOpen <- hIsOpen h' isOpen `shouldBe` False return res res `shouldBe` (ExitSuccess, bs, "") it "useHandleOpen+Close" $ withSystemTempFile "use-handle-open-close" $ \fp h -> do let bs1, bs2 :: IsString s => s bs1 = "this is a test 4\n" bs2 = "this is a test 5\n" runProcess_ ( setStdout (useHandleOpen h) $ setStdin bs1 "cat") runProcess_ ( setStdout (useHandleClose h) $ setStdin bs2 "cat") res <- S.readFile fp res `shouldBe` bs1 <> bs2 it "unchecked exit code" $ do res <- runProcess "false" res `shouldBe` ExitFailure 1 it "checked exit code" $ runProcess_ "false" `shouldThrow` \ExitCodeException{} -> True it "async" $ withSystemTempFile "httpbin" $ \fp h -> do bss <- withProcess (setStdin createSink $ setStdout createSource "base64") $ \p -> runConcurrently $ Concurrently ( httpSink "https://raw.githubusercontent.com/fpco/typed-process/master/README.md" $ \_res -> CB.conduitHandle h .| getStdin p) *> Concurrently ( runConduit $ getStdout p .| CL.consume) hClose h let encoded = S.filter (/= 10) $ S.concat bss raw <- S.readFile fp encoded `shouldBe` B64.encode raw typed-process-0.1.1/LICENSE0000644000000000000000000000207413000114611013473 0ustar0000000000000000Copyright (c) 2016 FP Complete, https://www.fpcomplete.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. typed-process-0.1.1/Setup.hs0000644000000000000000000000005613000114401014115 0ustar0000000000000000import Distribution.Simple main = defaultMain typed-process-0.1.1/typed-process.cabal0000644000000000000000000000323113147016207016265 0ustar0000000000000000name: 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 library hs-source-dirs: src exposed-modules: System.Process.Typed build-depends: base >= 4.7 && < 5 , async , bytestring , conduit , conduit-extra , exceptions , process >= 1.2 , stm , transformers if os(windows) cpp-options: -DWINDOWS default-language: Haskell2010 test-suite typed-process-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs other-modules: System.Process.TypedSpec build-depends: base , async , base64-bytestring , bytestring , conduit , conduit-extra , hspec , http-conduit >= 2.1.10 , temporary , typed-process ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 source-repository head type: git location: https://github.com/fpco/typed-process typed-process-0.1.1/README.md0000644000000000000000000003557713145035757014012 0ustar0000000000000000## typed-process [![Build Status](https://travis-ci.org/fpco/typed-process.svg?branch=master)](https://travis-ci.org/fpco/typed-process) [![Build status](https://ci.appveyor.com/api/projects/status/bhh7aekbgeqp7g5j/branch/master?svg=true)](https://ci.appveyor.com/project/snoyberg/typed-process/branch/master) 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 intends to improve upon it by: 1. Using type variables to represent the standard streams, making them easier to manipulate 2. Use proper concurrency (e.g., the async library) in place of the weird lazy I/O tricks for such things as consuming output streams 3. Allow for more complex concurrency by providing STM-based functions 4. Using binary I/O correctly 5. Providing a more composable API, designed to be easy to use for both simple and complex use cases ## Synopsis ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.IO (hPutStr, hClose) import System.Process.Typed import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8 import Control.Concurrent.STM (atomically) import Control.Exception (throwIO) main :: IO () main = do -- Run a process, print its exit code runProcess "true" >>= print runProcess "false" >>= print -- Check that the exit code is a success runProcess_ "true" -- This will throw an exception: runProcess_ "false" -- Capture output and error (dateOut, dateErr) <- readProcess_ "date" print (dateOut, dateErr) -- Use shell commands (dateOut2, dateErr2) <- readProcess_ "date >&2" print (dateOut2, dateErr2) -- Interact with a process let catConfig = setStdin createPipe $ setStdout byteStringOutput $ proc "cat" ["/etc/hosts", "-", "/etc/group"] withProcess_ catConfig $ \p -> do hPutStr (getStdin p) "\n\nHELLO\n" hPutStr (getStdin p) "WORLD\n\n\n" hClose (getStdin p) atomically (getStdout p) >>= L8.putStr ``` ## Types The two primary types in this package are `ProcessConfig` and `Process`. `ProcessConfig` gives a specification for how to run a process (e.g., the command to run, working directory, environment variables) and how to deal with the three standard streams: input, output, and error. You use one of the functions in this package for launching a process to turn a `ProcessConfig` into a `Process`, which represents an actual running system process. The easiest way to create a `ProcessConfig` is using the `IsString` instance and `OverloadedStrings`. For example, to run the `date` command, we can do the following. (NOTE: The type signatures used here are simply to spell things out, they are not needed.) ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = do let dateConfig :: ProcessConfig () () () dateConfig = "date" process <- startProcess dateConfig exitCode <- waitExitCode (process :: Process () () ()) print exitCode stopProcess process ``` This shows the general workflow: use `startProcess` to launch a `Process` from a `ProcessConfig`, interact with it (such as `waitExitCode` to wait for the process to exit), and then clean up resources with `stopProcess`. (We'll get to those `() () ()` type parameters in the next section.) Instead of explicitly dealing with `startProcess` and `stopProcess`, it's recommended to instead use `withProcess`, which uses the bracket pattern and is exception safe: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = withProcess "date" $ \process -> do exitCode <- waitExitCode (process :: Process () () ()) print exitCode ``` But this pattern of running a process, waiting for it to exit, and getting its exit code is very common, so it has a helper function of its own: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = do exitCode <- runProcess "date" print exitCode ``` We'll discuss some functions which automatically check the exit code below. ## Type parameters Both `ProcessConfig` and `Process` each take three type parameters, with the type of the standard input, output, and error streams for the process. As you saw above, our default is `()` for each, and our default behavior is to inherit the streams from the parent process. This is why, when you run the previous programs, the `date` program's output goes directly to your console. We can override these defaults in a number of ways. Perhaps the easiest is to simply close the stream for the child so it cannot use it at all. ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = do let dateConfig :: ProcessConfig () () () dateConfig = setStdin closed $ setStdout closed $ setStderr closed "date" exitCode <- runProcess dateConfig print exitCode ``` A few things to note: * The type parameter is still `()`, since there's no data to return. We'll see some more interesting cases later. * This process now returns an `ExitFailure 1`, since it tries to write to a closed `stdout` file descriptor. ## Using `proc` and `shell` Using the `OverloadedStrings` approach works nicely for some cases, but we'll often want more control over things. There are two smart constructors available: `proc` takes a command and list of arguments, and `shell` takes a single string which will be passed directly to the system's shell. ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = do -- Command and arguments runProcess (proc "cat" ["/etc/hosts"]) >>= print -- Shell runProcess (shell "cat /etc/hosts >&2 && false") >>= print ``` The behavior of the `OverloadedStrings` approach we've used until now is actually based on these two smart constructors. If you provide it a string without any spaces (like `"date"`), it will use `proc` without any arguments, e.g. `fromString "date" = proc "date" []`. If there are any spaces in the string, it will use `shell`. __EXERCISE__: Rewrite the previous example to not use the `shell` constructor. ## Checking the exit code We've done a lot of printing of exit codes. In many cases, we don't actually want to look at the exit code, but instead just throw an exception if the process failed. Fortunately, we have such an exit-code-checking function. ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = runProcess_ "date" ``` By adding the `_` at the end of `runProcess`, we're now automatically checking the exit code and throwing an exception if it returns anything but success. Want to see it in action? ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = runProcess_ "false" ``` Under the surface, this function is using the `checkExitCode` function. We can do this more explicitly if desired: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = withProcess "false" checkExitCode ``` ## Reading from a process Sending all output to the parent process's handles is sometimes desired, but often we'd rather just capture that output. The easiest way to do that is to capture it in memory as a lazy `ByteString`. Fortunately, we have a helper `readProcess` function for that: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.Exit (ExitCode) import Data.ByteString.Lazy (ByteString) main :: IO () main = do (exitCode, out, err) <- readProcess "date" print (exitCode :: ExitCode) print (out :: ByteString) print (err :: ByteString) ``` One thing to point out is that, even though this is a lazy `ByteString`, it is not using any lazy I/O. When `readProcess` exits, the output has been fully generated, and is resident in memory. We only use a lazy `ByteString` instead of a strict one for better memory configuration (chunking into multiple smaller bits instead of one massive chunk of data). Like `runProcess`, there's an exit-code-checking variant of `readProcess`: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import Data.ByteString.Lazy (ByteString) main :: IO () main = do (out, err) <- readProcess_ "date" print (out :: ByteString) print (err :: ByteString) ``` __EXERCISE__: Use shell redirection to move the output from standard output to standard error. ## Redirecting to a file Another technique we'll commonly want to employ is to redirect output from a process to a file. This is superior to the memory approach as it does not have the risk of using large amounts of memory, though it is more inconvenient. Together with the [temporary library](https://www.stackage.org/package/temporary), we can do some nice things: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO.Temp (withSystemTempFile) main :: IO () main = withSystemTempFile "date" $ \fp h -> do let dateConfig = setStdin closed $ setStdout (useHandleClose h) $ setStderr closed "date" runProcess_ dateConfig readFile fp >>= print ``` The `useHandleClose` function lets us provide an already existing `Handle`, and will close it when done. If you want to write the output of multiple processes to a single file, you can instead use `useHandleOpen`: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO (hClose) import System.IO.Temp (withSystemTempFile) import Control.Monad (replicateM_) main :: IO () main = withSystemTempFile "date" $ \fp h -> do let dateConfig = setStdin closed $ setStdout (useHandleOpen h) $ setStderr closed "date" replicateM_ 10 $ runProcess_ dateConfig hClose h readFile fp >>= putStrLn ``` __EXERCISE__ Create a separate file for error output and capture that as well. ## Providing input Using `OverloadedStrings`, it's trivial to provide some input to a process: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = runProcess_ $ setStdin "Hello World!\n" "cat" ``` This is just a shortcut for using the `byteStringInput` function: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = runProcess_ $ setStdin (byteStringInput "Hello World!\n") "cat" ``` But like output and error, we can also use a `Handle` or a temporary file: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process --package temporary {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO import System.IO.Temp (withSystemTempFile) main :: IO () main = withSystemTempFile "input" $ \fp h -> do hPutStrLn h "Hello World!" hClose h withBinaryFile fp ReadMode $ \h' -> runProcess_ $ setStdin (useHandleClose h') "cat" ``` ## Interacting with a process So far, everything we've done has been _running_ processes: spawning a child with some settings, then waiting for it to exit. We will often want to _interact_ with a process: spawn it, and then send it input or receive output from it while it is still running. For this, using `createPipe` makes a lot of sense: ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed import System.IO main :: IO () main = do let catConfig = setStdin createPipe $ setStdout createPipe $ setStderr closed "cat" withProcess_ catConfig $ \p -> do hPutStrLn (getStdin p) "Hello!" hFlush (getStdin p) hGetLine (getStdout p) >>= print hClose (getStdin p) ``` __EXERCISE__: What happens if you remove the `hClose` line, and why? Hint: what happens if you both remove `hClose` _and_ replace `withProcess_` with `withProcess`? ## Other settings We've so far only played with modifying streams, but there are a number of other settings you can tweak. It's best to just look at the API docs for all available functions. We'll give examples of the two most common settings: the working directory and environment variables. ```haskell #!/usr/bin/env stack -- stack --resolver lts-7.3 --install-ghc runghc --package typed-process {-# LANGUAGE OverloadedStrings #-} import System.Process.Typed main :: IO () main = do putStrLn "1:" runProcess_ "pwd" putStrLn "\n2:" runProcess_ $ setWorkingDir "/tmp" "pwd" putStrLn "\n3:" runProcess_ "env" putStrLn "\n4:" runProcess_ $ setEnv [("HELLO", "WORLD")] "env" ``` ## Async and STM When interacting with a process on multiple streams, you'll often want to use some kind of concurrency. The strong recommendation is to use the [async library](https://haskell-lang.org/library/async). Additionally, this library provides a number of functions that use STM, which also plays very nicely with concurrency and the async package. For some examples, check out: * `waitExitCodeSTM` * `getExitCodeSTM` * `checkExitCodeSTM` * `byteStringOutput` __EXERCISE__ Reimplement the `readProcess` function using `byteStringOutput` and `waitExitCodeSTM`. __EXERCISE__ Reimplement the `readProcess_` function using `byteStringOutput` and `checkExitCodeSTM`. typed-process-0.1.1/ChangeLog.md0000644000000000000000000000027013147016212014645 0ustar0000000000000000## 0.1.1 * Introduce 'unsafeProcessHandle' function ## 0.1.0.1 * Fix bug in `waitForProcess` that caused exit code to be lost * Minor doc improvements ## 0.1.0.0 * Initial commit