diff --git a/Benchmark/System/Process.hs b/Benchmark/System/Process.hs index a97a6c2..4b1a82b 100644 --- a/Benchmark/System/Process.hs +++ b/Benchmark/System/Process.hs @@ -23,7 +23,6 @@ import qualified Streamly.Internal.System.Command as Cmd -- Internal imports import qualified Streamly.Internal.FileSystem.Handle as FH -import qualified Streamly.Internal.System.Process as Proc -- XXX replace with streamly versions once they are fixed {-# INLINE rights #-} diff --git a/CHANGELOG.md b/CHANGELOG.md index c61c017..8cb343a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Changelog +## 0.3.1 (Dec 2023) + +* Allow streamly-0.10.0 and streamly-core-0.2.0 +* Fix a bug in quote escaping in the Command module + ## 0.3.0 (Apr 2023) * Added a `Streamly.System.Command` module diff --git a/src/DocTestCommand.hs b/src/DocTestCommand.hs index 73c2f82..06f863c 100644 --- a/src/DocTestCommand.hs +++ b/src/DocTestCommand.hs @@ -14,7 +14,7 @@ For APIs that have not been released yet. ->>> import qualified Streamly.Internal.Console.Stdio as Stdio ->>> import qualified Streamly.Internal.FileSystem.Dir as Dir +>>> import qualified Streamly.Internal.Console.Stdio as Stdio (putBytes, putChars, putChunks) +>>> import qualified Streamly.Internal.FileSystem.Dir as Dir (readFiles) >>> import qualified Streamly.Internal.System.Process as Process -} diff --git a/src/DocTestProcess.hs b/src/DocTestProcess.hs index 3db334e..d882a18 100644 --- a/src/DocTestProcess.hs +++ b/src/DocTestProcess.hs @@ -13,9 +13,8 @@ For APIs that have not been released yet. ->>> import qualified Streamly.Internal.Console.Stdio as Stdio ->>> import qualified Streamly.Internal.Data.Stream as Stream ->>> import qualified Streamly.Internal.FileSystem.Dir as Dir +>>> import qualified Streamly.Internal.Console.Stdio as Stdio (putChars, putChunks) +>>> import qualified Streamly.Internal.FileSystem.Dir as Dir (readFiles) >>> import qualified Streamly.Internal.System.Process as Process ->>> import qualified Streamly.Internal.Unicode.Stream as Unicode +>>> import qualified Streamly.Internal.Unicode.Stream as Unicode (lines) -} diff --git a/src/Streamly/Internal/System/Command.hs b/src/Streamly/Internal/System/Command.hs index 532e15e..26f63d4 100644 --- a/src/Streamly/Internal/System/Command.hs +++ b/src/Streamly/Internal/System/Command.hs @@ -53,7 +53,7 @@ import qualified Streamly.Internal.System.Process as Process #include "DocTestCommand.hs" --- Posix compliant quote excaping: +-- | Posix compliant quote escaping: -- -- $ echo 'hello\\"world' -- hello\\"world @@ -169,7 +169,7 @@ pipeWith f cmd input = -- If the input stream throws an exception or if the output stream is garbage -- collected before it could finish then the process is terminated with SIGTERM. -- --- If the process terminates with a non-zero exit code then a 'ProcessFailure' +-- If the process terminates with a non-zero exit code then a 'Process.ProcessFailure' -- exception is raised. -- -- The following code is equivalent to the shell command @echo "hello world" | @@ -224,10 +224,9 @@ pipeChars = pipeWith Process.pipeChars -- Generation ------------------------------------------------------------------------------- --- | --- -- >>> toBytes = streamWith Process.toBytes --- + +-- | -- >>> toBytes "echo hello world" & Stdio.putBytes --hello world -- >>> toBytes "echo hello\\ world" & Stdio.putBytes @@ -242,10 +241,9 @@ pipeChars = pipeWith Process.pipeChars toBytes :: (MonadAsync m, MonadCatch m) => String -> Stream m Word8 toBytes = streamWith Process.toBytes --- | --- -- >>> toChunks = streamWith Process.toChunks --- + +-- | -- >>> toChunks "echo hello world" & Stdio.putChunks --hello world -- @@ -254,9 +252,9 @@ toBytes = streamWith Process.toBytes toChunks :: (MonadAsync m, MonadCatch m) => String -> Stream m (Array Word8) toChunks = streamWith Process.toChunks --- | -- >>> toChars = streamWith Process.toChars --- + +-- | -- >>> toChars "echo hello world" & Stdio.putChars --hello world -- @@ -265,9 +263,9 @@ toChunks = streamWith Process.toChunks toChars :: (MonadAsync m, MonadCatch m) => String -> Stream m Char toChars = streamWith Process.toChars --- | -- >>> toLines f = streamWith (Process.toLines f) --- + +-- | -- >>> toLines Fold.toList "echo -e hello\\\\nworld" & Stream.fold Fold.toList -- ["hello","world"] -- @@ -280,9 +278,9 @@ toLines :: -> Stream m a -- ^ Output Stream toLines f = streamWith (Process.toLines f) --- | -- >>> toString = runWith Process.toString --- + +-- | -- >>> toString "echo hello world" --"hello world\n" -- @@ -294,9 +292,9 @@ toString :: -> m String toString = runWith Process.toString --- | -- >>> toStdout = runWith Process.toStdout --- + +-- | -- >>> toStdout "echo hello world" -- hello world -- @@ -308,9 +306,9 @@ toStdout :: -> m () toStdout = runWith Process.toStdout --- | -- >>> toNull = runWith Process.toNull --- + +-- | -- >>> toNull "echo hello world" -- -- /Pre-release/ diff --git a/src/Streamly/Internal/System/Process.hs b/src/Streamly/Internal/System/Process.hs index 13a4452..6cb6ed1 100644 --- a/src/Streamly/Internal/System/Process.hs +++ b/src/Streamly/Internal/System/Process.hs @@ -60,17 +60,18 @@ module Streamly.Internal.System.Process -} , closeFiles , newProcessGroup + , Session (..) , setSession -- * Posix Only Options -- | These options have no effect on Windows. - , parentIgnoresInterrupt + , interruptChildOnly , setUserId , setGroupId -- * Windows Only Options -- | These options have no effect on Posix. - , waitForChildTree + , waitForDescendants -- * Internal , inheritStdin @@ -111,11 +112,14 @@ module Streamly.Internal.System.Process , pipeChunksEitherWith -- * Standalone Processes - , standalone - , interactive + , foreground , daemon + , standalone -- * Deprecated + , parentIgnoresInterrupt + , waitForChildTree + , interactive , processBytes , processChunks ) @@ -261,7 +265,7 @@ mkConfig path args = Config $ CreateProcess -- working directory is inherited from the parent process. -- -- Default is 'Nothing' - inherited from the parent process. -setCwd :: Maybe (FilePath) -> Config -> Config +setCwd :: Maybe FilePath -> Config -> Config setCwd path (Config cfg) = Config $ cfg { cwd = path } -- | Set the environment variables for the new process. When 'Nothing', the @@ -326,7 +330,9 @@ closeFiles x (Config cfg) = Config $ cfg { close_fds = x } -- | If 'True' the new process starts a new process group, becomes a process -- group leader, its pid becoming the process group id. -- --- See the POSIX @setpgid@ man page. +-- See the POSIX +-- +-- man page. -- -- Default is 'False', the new process belongs to the parent's process group. newProcessGroup :: Bool -> Config -> Config @@ -336,7 +342,9 @@ newProcessGroup x (Config cfg) = Config $ cfg { create_group = x } -- parent process. This is the default. -- -- 'NewSession' makes the new process start with a new session without a --- controlling terminal. On POSIX, @setsid@ is used to create a new process +-- controlling terminal. On POSIX, +-- +-- is used to create a new process -- group and session, the pid of the new process is the session id and process -- group id as well. On Windows @DETACHED_PROCESS@ flag is used to detach the -- process from inherited console session. @@ -346,10 +354,12 @@ newProcessGroup x (Config cfg) = Config $ cfg { create_group = x } -- nothing. -- -- For Windows see +-- -- * https://learn.microsoft.com/en-us/windows/win32/procthread/process-creation-flags -- * https://learn.microsoft.com/en-us/windows/console/creation-of-a-console . -- --- For POSIX see, @setsid@ man page. +-- For POSIX see, +-- man page. data Session = InheritSession -- ^ Inherit the parent session | NewSession -- ^ Detach process from the current session @@ -366,11 +376,15 @@ setSession x (Config cfg) = NewSession -> cfg { new_session = True} NewConsole -> cfg {create_new_console = True} --- | Use the POSIX @setuid@ call to set the user id of the new process before +-- | Use the POSIX +-- +-- call to set the user id of the new process before -- executing the command. The parent process must have sufficient privileges to -- set the user id. -- --- POSIX only. See the POSIX @setuid@ man page. +-- POSIX only. See the POSIX +-- +-- man page. -- -- Default is 'Nothing' - inherit from the parent. setUserId :: Maybe Word32 -> Config -> Config @@ -382,11 +396,15 @@ setUserId x (Config cfg) = Config $ cfg { child_user = CUid <$> x } #endif --- | Use the POSIX @setgid@ call to set the group id of the new process before +-- | Use the POSIX +-- +-- call to set the group id of the new process before -- executing the command. The parent process must have sufficient privileges to -- set the group id. -- --- POSIX only. See the POSIX @setgid@ man page. +-- POSIX only. See the POSIX +-- +-- man page. -- -- Default is 'Nothing' - inherit from the parent. setGroupId :: Maybe Word32 -> Config -> Config @@ -414,15 +432,23 @@ setGroupId x (Config cfg) = -- until the child exits. -- -- POSIX only. Default is 'False'. +interruptChildOnly :: Bool -> Config -> Config +interruptChildOnly x (Config cfg) = Config $ cfg { delegate_ctlc = x } + +{-# DEPRECATED parentIgnoresInterrupt "Use interruptChildOnly instead." #-} parentIgnoresInterrupt :: Bool -> Config -> Config -parentIgnoresInterrupt x (Config cfg) = Config $ cfg { delegate_ctlc = x } +parentIgnoresInterrupt = interruptChildOnly --- | On Windows, the parent waits for the entire tree of process i.e. including --- processes that are spawned by the child process. +-- | On Windows, the parent waits for the entire descendant tree of process +-- i.e. including processes that are spawned by the child process. -- -- Default is 'True'. +waitForDescendants :: Bool -> Config -> Config +waitForDescendants x (Config cfg) = Config $ cfg { use_process_jobs = x } + +{-# DEPRECATED waitForChildTree "Use waitForDescendants instead." #-} waitForChildTree :: Bool -> Config -> Config -waitForChildTree x (Config cfg) = Config $ cfg { use_process_jobs = x } +waitForChildTree = waitForDescendants pipeStdErr :: Config -> Config pipeStdErr (Config cfg) = Config $ cfg { std_err = CreatePipe } @@ -585,6 +611,8 @@ pipeChunksWithAction run modCfg path args = alloc = createProc' modCfg path args +-- | Like 'pipeChunksEither' but use the specified configuration to run the +-- process. {-# INLINE pipeChunksEitherWith #-} pipeChunksEitherWith :: (MonadCatch m, MonadAsync m) @@ -604,6 +632,8 @@ pipeChunksEitherWith modifier path args input = `parallel` fmap Right (toChunksClose stdoutH) run _ = error "pipeChunksEitherWith: Not reachable" +-- | Like 'pipeChunks' but also includes stderr as 'Left' stream in the +-- 'Either' output. {-# INLINE pipeChunksEither #-} pipeChunksEither :: (MonadCatch m, MonadAsync m) @@ -647,6 +677,7 @@ pipeBytesEither path args input = rightRdr = fmap Right Array.reader in Stream.unfoldMany (Unfold.either leftRdr rightRdr) output +-- | Like 'pipeChunks' but use the specified configuration to run the process. {-# INLINE pipeChunksWith #-} pipeChunksWith :: (MonadCatch m, MonadAsync m) @@ -780,6 +811,8 @@ pipeChars path args input = -- Generation ------------------------------------------------------------------------------- +-- | Like 'toChunksEither' but use the specified configuration to run the +-- process. {-# INLINE toChunksEitherWith #-} toChunksEitherWith :: (MonadCatch m, MonadAsync m) @@ -797,6 +830,7 @@ toChunksEitherWith modifier path args = `parallel` fmap Right (toChunksClose stdoutH) run _ = error "toChunksEitherWith: Not reachable" +-- | Like 'toChunks' but use the specified configuration to run the process. {-# INLINE toChunksWith #-} toChunksWith :: (MonadCatch m, MonadAsync m) @@ -863,7 +897,7 @@ toBytes path args = let output = toChunks path args in Stream.unfoldMany Array.reader output --- | Like 'toBytes' but generates a stream of @Array Word8@ instead of a stream +-- | Like 'toBytesEither' but generates a stream of @Array Word8@ instead of a stream -- of @Word8@. -- -- >>> :{ @@ -876,7 +910,7 @@ toBytes path args = -- -- >>> toChunksEither = toChunksEitherWith id -- --- Prefer 'toChunksEither over 'toBytesEither when performance matters. +-- Prefer 'toChunksEither' over 'toBytesEither' when performance matters. -- -- /Pre-release/ {-# INLINE toChunksEither #-} @@ -970,9 +1004,24 @@ toNull :: toNull path args = toChunks path args & Stream.fold Fold.drain ------------------------------------------------------------------------------- --- Process not interacting with the parent process +-- Processes not interacting with the parent process ------------------------------------------------------------------------------- +-- XXX Make the return type ExitCode/ProcessHandle depend on the wait argument? + +-- | Launch a standalone process i.e. the process does not have a way to attach +-- the IO streams with other processes. The IO streams stdin, stdout, stderr +-- can either be inherited from the parent or closed. +-- +-- This API is more powerful than 'interactive' and 'daemon' and can be used to +-- implement both of these. However, it should be used carefully e.g. if you +-- inherit the IO streams and parent is not waiting for the child process to +-- finish then both parent and child may use the IO streams resulting in +-- garbled IO if both are reading/writing simultaneously. +-- +-- If the parent chooses to wait for the process an 'ExitCode' is returned +-- otherwise a 'ProcessHandle' is returned which can be used to terminate the +-- process, send signals to it or wait for it to finish. {-# INLINE standalone #-} standalone :: Bool -- ^ Wait for process to finish? @@ -988,7 +1037,7 @@ standalone wait (close_stdin, close_stdout, close_stderr) modCfg path args = postCreate _ _ _ procHandle = if wait - then fmap Left $ waitForProcess procHandle + then Left <$> waitForProcess procHandle else return $ Right procHandle cfg = @@ -998,38 +1047,50 @@ standalone wait (close_stdin, close_stdout, close_stderr) modCfg path args = s_err = if close_stderr then NoStream else Inherit in c {std_in = s_in, std_out = s_out, std_err = s_err} --- | Inherits stdin, stdout, and stderr from the parent, so that the user can --- interact with the process, user interrupts are handled by the child process, --- the parent waits for the child process to exit. +-- | Launch a process interfacing with the user. User interrupts are sent to +-- the launched process and ignored by the parent process. The launched process +-- inherits stdin, stdout, and stderr from the parent, so that the user can +-- interact with the process. The parent waits for the child process to exit, +-- an 'ExitCode' is returned when the process finishes. -- --- This is same as the common @system@ function found in other libraries used --- to execute commands. +-- This is the same as the common @system@ function found in other libraries +-- used to execute commands. -- -- On Windows you can pass @setSession NewConsole@ to create a new console. -- +{-# INLINE foreground #-} +foreground :: + (Config -> Config) + -> FilePath -- ^ Executable name or path + -> [String] -- ^ Arguments + -> IO ExitCode +foreground modCfg path args = + let r = + standalone + True + (False, False, False) + (parentIgnoresInterrupt True . modCfg) + path args + in fmap (either id undefined) r + +{-# DEPRECATED interactive "Use foreground instead." #-} {-# INLINE interactive #-} interactive :: (Config -> Config) -> FilePath -- ^ Executable name or path -> [String] -- ^ Arguments -> IO ExitCode -interactive modCfg path args = - withCreateProcess cfg (\_ _ _ p -> waitForProcess p) - - where - - -- let child handle SIGINT/QUIT - modCfg1 = (parentIgnoresInterrupt True . modCfg) - - cfg = - let Config c = modCfg1 $ mkConfig path args - in c {std_in = Inherit, std_out = Inherit, std_err = Inherit} +interactive = foreground -- XXX ProcessHandle can be used to terminate the process. re-export -- terminateProcess? --- | Closes stdin, stdout and stderr, creates a new session, detached from the --- terminal, the parent does not wait for the process to finish. +-- | Launch a daemon process. Closes stdin, stdout and stderr, creates a new +-- session, detached from the terminal, the parent does not wait for the +-- process to finish. +-- +-- The 'ProcessHandle' returned can be used to terminate the daemon or send +-- signals to it. -- {-# INLINE daemon #-} daemon :: @@ -1037,13 +1098,11 @@ daemon :: -> FilePath -- ^ Executable name or path -> [String] -- ^ Arguments -> IO ProcessHandle -daemon modCfg path args = withCreateProcess cfg (\_ _ _ p -> return p) - - where - - -- Detach terminal - modCfg1 = (setSession NewSession . modCfg) - - cfg = - let Config c = modCfg1 $ mkConfig path args - in c {std_in = NoStream, std_out = NoStream, std_err = NoStream} +daemon modCfg path args = + let r = + standalone + False + (True, True, True) + (setSession NewSession . modCfg) + path args + in fmap (either undefined id) r diff --git a/src/Streamly/System/Command.hs b/src/Streamly/System/Command.hs index 7b7efc4..c4bcae1 100644 --- a/src/Streamly/System/Command.hs +++ b/src/Streamly/System/Command.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Module : Streamly.System.Command -- Copyright : (c) 2023 Composewell Technologies @@ -6,83 +7,18 @@ -- Stability : experimental -- Portability : GHC -- --- Use command strings to execute OS processes. These processes can be used --- just like native Haskell functions - to generate, transform or consume --- streams. It provides a powerful way to write high-level Haskell scripts to --- perform tasks similar to shell scripts without requiring the shell. --- Moreover, the Haskell scripts provide C-like performance. --- --- This module is a wrapper over the "Streamly.System.Process" module. --- --- See also: "Streamly.Internal.System.Command". --- -{-# LANGUAGE CPP #-} - -module Streamly.System.Command - ( - -- * Setup - -- | To execute the code examples provided in this module in ghci, please - -- run the following commands first. - -- - -- $setup - - -- * Overview - -- $overview - - -- * Types - ProcessFailure (..) - - -- * Generation - , toBytes - , toChunks - , toChars - , toLines - - -- * Effects - , toString - , toStdout - , toNull - - -- * Transformation - , pipeBytes - , pipeChars - , pipeChunks - - -- -- * Helpers - -- , runWith - -- , streamWith - -- , pipeWith - ) -where - -import Streamly.Internal.System.Command -import Streamly.Internal.System.Process (ProcessFailure (..)) - --- Keep it synced with the Internal module - -#include "DocTestCommand.hs" --- Note: Commands are not executed using shell --- --- You can use this module to execute system commands and compose them with --- Haskell. It does not use the system shell to execute commands, they are --- executed as independent processes. This provides a convenient and powerful --- way to replace shell scripting with Haskell. Instead of composing commands --- using shell you can use Haskell Streamly streaming APIs to compose them with --- better efficiency and type safety. --- --- Normally, you should not need the system shell but if you want to use shell --- scripts in your program then you can take a look at the @streamly-shell@ --- package which provides convenient wrapper over "Streamly.System.Process" to --- execute shell scripts, commands. - --- $overview --- --- Please see the "Streamly.System.Process" for basics. +-- This module provides a way to invoke external executables and use them +-- seamlessly in a Haskell program, in a streaming fashion. This enables you to +-- write high-level Haskell scripts to perform tasks similar to shell scripts +-- without requiring the shell. Moreover, Haskell scripts provide C-like +-- performance. -- --- "Streamly.System.Process" module requires specifying the command executable --- name and its arguments separately (e.g. "ls" "-al") whereas using this --- module we can specify the executable and its arguments more conveniently as --- a single command string e.g. we can execute "ls -al". +-- Please see the "Streamly.System.Process" for basics. This module is a +-- wrapper over that module. "Streamly.System.Process" requires +-- specifying a command executable name and its arguments separately (e.g. +-- "ls" "-al") whereas using this module we can specify the executable and its +-- arguments more conveniently as a single command string e.g. we can execute +-- "ls -al". -- -- A command string is parsed in the same way as a posix shell would parse it. -- A command string consists of whitespace separated tokens with the first @@ -116,7 +52,9 @@ import Streamly.Internal.System.Process (ProcessFailure (..)) -- -- = Shell commands as functions -- --- If you want to execute the same command using the shell: +-- We recommend using streamly to compose commands natively in Haskell rather +-- than using the shell as shown in the previous example. However, if for some +-- reason you want to execute commands using the shell: -- -- >>> :{ -- Command.toBytes [str|sh "-c" "echo 'hello world' | tr [a-z] [A-Z]"|] @@ -126,7 +64,8 @@ import Streamly.Internal.System.Process (ProcessFailure (..)) -- -- = Running Commands Concurrently -- --- Running @grep@ concurrently on many files: +-- This example shows the power of composing in Haskell rather than using the +-- shell. Running @grep@ concurrently on many files: -- -- >>> :{ -- grep file = @@ -142,3 +81,61 @@ import Streamly.Internal.System.Process (ProcessFailure (..)) -- & Stream.fold Stdio.writeChunks -- :} -- +-- = Experimental APIs +-- +-- See "Streamly.Internal.System.Command" for unreleased APIs. +-- + +module Streamly.System.Command + ( + -- * Setup + -- | To execute the code examples provided in this module in ghci, please + -- run the following commands first. + -- + -- $setup + + -- * Types + ProcessFailure (..) + + -- * Generation + , toBytes + , toChunks + , toChars + , toLines + + -- * Effects + , toString + , toStdout + , toNull + + -- * Transformation + , pipeBytes + , pipeChars + , pipeChunks + + -- -- * Helpers + -- , runWith + -- , streamWith + -- , pipeWith + ) +where + +import Streamly.Internal.System.Command +import Streamly.Internal.System.Process (ProcessFailure (..)) + +-- Keep it synced with the Internal module + +#include "DocTestCommand.hs" +-- Note: Commands are not executed using shell +-- +-- You can use this module to execute system commands and compose them with +-- Haskell. It does not use the system shell to execute commands, they are +-- executed as independent processes. This provides a convenient and powerful +-- way to replace shell scripting with Haskell. Instead of composing commands +-- using shell you can use Haskell Streamly streaming APIs to compose them with +-- better efficiency and type safety. +-- +-- Normally, you should not need the system shell but if you want to use shell +-- scripts in your program then you can take a look at the @streamly-shell@ +-- package which provides convenient wrapper over "Streamly.System.Process" to +-- execute shell scripts, commands. diff --git a/src/Streamly/System/Process.hs b/src/Streamly/System/Process.hs index 8f18bbd..ff5170b 100644 --- a/src/Streamly/System/Process.hs +++ b/src/Streamly/System/Process.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Module : Streamly.System.Process -- Copyright : (c) 2020 Composewell Technologies @@ -6,86 +7,19 @@ -- Stability : experimental -- Portability : GHC -- --- Use OS processes just like native Haskell functions - to generate, transform --- or consume streams. --- --- See "Streamly.System.Command" module for a higher level wrapper over this --- module. --- --- See also: "Streamly.Internal.System.Process" for unreleased functions. --- -{-# LANGUAGE CPP #-} - -module Streamly.System.Process - ( - -- * Setup - -- | To execute the code examples provided in this module in ghci, please - -- run the following commands first. - -- - -- $setup - - -- * Overview - -- $overview - - -- * Exceptions - -- | Since we are composing using Streamly's streaming pipeline there is - -- nothing special about exception handling, it works the same as in - -- Streamly. Like the @pipefail@ option in shells, exceptions are - -- propagated if any of the stages fail. - ProcessFailure (..) - - -- * Process Configuration - , Config - - {- - -- ** Common Config Options - -- | These options apply to both POSIX and Windows. - , setCwd - , setEnv - , closeFiles - , newProcessGroup - , setSession - - -- * Posix Only Options - -- | These options have no effect on Windows. - , parentIgnoresInterrupt - , setUserId - , setGroupId - - -- * Windows Only Options - -- | These options have no effect on Posix. - , waitForChildTree - -} - - -- * Generation - , toChunks - , toBytes - - -- * Transformation - , pipeChunks - , pipeBytes - - -- * Deprecated - , processChunks - , processBytes - ) -where - -import Streamly.Internal.System.Process - -#include "DocTestProcess.hs" - --- $overview --- -- This module provides functions to run operating system processes as stream --- source, sink or transformation functions. Thus OS processes can be used in --- the same way as Haskell functions and all the streaming combinators in --- streamly can be used to combine them. This allows you to seamlessly --- integrate external programs into your Haskell program. +-- producers, consumers or stream transformation functions. Thus OS processes +-- can be used in the same way as Haskell functions and all the streaming +-- combinators in streamly can be used to combine them. This allows you to +-- seamlessly integrate external binary executables into your Haskell program. +-- +-- However, we recommend native Haskell functions with Streamly threads over +-- using system processes whenever possible. This approach offers a simpler +-- programming model compared to system processes, which also have a larger +-- performance overhead. -- --- We recommend using Haskell functions with Streamly threads for performing --- tasks whenever possible. This approach offers a simpler programming model --- compared to system processes, which also have a larger performance overhead. +-- Prefer "Streamly.System.Command" module as a higher level wrapper over this +-- module. -- -- = Executables as functions -- @@ -139,3 +73,88 @@ import Streamly.Internal.System.Process -- & Stream.parConcatMap id grep -- & Stream.fold Stdio.writeChunks -- :} +-- +-- = Experimental APIs +-- +-- See "Streamly.Internal.System.Process" for unreleased functions. +-- + +module Streamly.System.Process + ( + -- * Setup + -- | To execute the code examples provided in this module in ghci, please + -- run the following commands first. + -- + -- $setup + + -- * Exceptions + -- | Since we are composing using Streamly's streaming pipeline there is + -- nothing special about exception handling, it works the same as in + -- Streamly. Like the @pipefail@ option in shells, exceptions are + -- propagated if any of the stages fail. + ProcessFailure (..) + + -- * Process Configuration + -- | Use the config modifiers to modify the default config. + , Config + + -- ** Common Modifiers + -- | These options apply to both POSIX and Windows. + , setCwd + , setEnv + , closeFiles + , newProcessGroup + , Session (..) + , setSession + + -- ** Posix Only Modifiers + -- | These options have no effect on Windows. + , interruptChildOnly + , setUserId + , setGroupId + + -- ** Windows Only Modifiers + -- | These options have no effect on Posix. + , waitForDescendants + + -- * Generation + , toChunks + , toChunksWith + , toBytes + , toChars + , toLines + , toString + , toStdout + , toNull + + -- * Transformation + , pipeChunks + , pipeChunksWith + , pipeBytes + + -- * Including Stderr Stream + -- | Like other "Generation" routines but along with stdout, stderr is also + -- included in the output stream. stdout is converted to 'Right' values in + -- the output stream and stderr is converted to 'Left' values. + , toBytesEither + , toChunksEither + , toChunksEitherWith + , pipeBytesEither + , pipeChunksEither + , pipeChunksEitherWith + + -- * Non-streaming Processes + -- | These processes do not attach the IO streams with other processes. + , foreground + , daemon + , standalone + + -- * Deprecated + , processChunks + , processBytes + ) +where + +import Streamly.Internal.System.Process + +#include "DocTestProcess.hs" diff --git a/streamly-process.cabal b/streamly-process.cabal index de94448..055085c 100644 --- a/streamly-process.cabal +++ b/streamly-process.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: streamly-process -version: 0.3.0 +version: 0.3.1 synopsis: Use OS processes as stream transformation functions description: Use operating system (OS) commands in Haskell programs as if they were diff --git a/test/Streamly/System/Process.hs b/test/Streamly/System/Process.hs index 553084b..0781bf9 100644 --- a/test/Streamly/System/Process.hs +++ b/test/Streamly/System/Process.hs @@ -34,8 +34,6 @@ import qualified Streamly.System.Process as Proc import qualified Streamly.Data.Stream as Stream import qualified Streamly.Internal.FileSystem.Handle as FH (putBytes, read) -import qualified Streamly.Internal.System.Process as Proc - (pipeChunksEither, pipeBytesEither, toChunksEither, toBytesEither) import qualified Streamly.Internal.System.Command as Cmd (quotedWord) newtype SimpleError = SimpleError String