-- |
-- Module      : Streamly.Internal.System.Command
-- Copyright   : (c) 2022 Composewell Technologies
-- License     : Apache-2.0
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}

module Streamly.Internal.System.Command
    (
    -- * Generation
      toBytes
    , toChunks
    , toChunksWith
    , toChars
    , toLines

    -- * Effects
    , toString
    , toStdout
    , toNull

    -- * Transformation
    , pipeBytes
    , pipeChars
    , pipeChunks
    , pipeChunksWith

    -- * Standalone Processes
    , standalone
    , foreground
    , daemon

    -- * Helpers
    , quotedWord
    , runWith
    , streamWith
    , pipeWith
    )
where

import Control.Monad.Catch (MonadCatch)
import Data.Char (isSpace)
import Data.Word (Word8)
import Streamly.Data.Array (Array)
import Streamly.Data.Fold (Fold)
import Streamly.Data.Parser (Parser)
import Streamly.Data.Stream.Prelude (MonadAsync, Stream)
import Streamly.Internal.System.Process (Config)
import System.Exit (ExitCode(..))
import System.Process (ProcessHandle)

import qualified Streamly.Data.Fold as Fold
import qualified Streamly.Data.Parser as Parser
import qualified Streamly.Data.Stream.Prelude as Stream
import qualified Streamly.Internal.System.Process as Process

-- Keep it synced with the released module

#include "DocTestCommand.hs"

-- | Posix compliant quote escaping:
--
-- $ echo 'hello\\"world'
-- hello\\"world
--
-- $ echo "hello\"\\w\'orld"
-- hello"\w\'orld
--
-- $ echo 'hello\'
-- hello\
{-# INLINE quotedWord #-}
quotedWord :: MonadCatch m => Parser Char m String
quotedWord :: forall (m :: * -> *). MonadCatch m => Parser Char m String
quotedWord =
    let toRQuote :: Char -> Maybe Char
toRQuote Char
x =
            case Char
x of
                Char
'"' -> forall a. a -> Maybe a
Just Char
x
                Char
'\'' -> forall a. a -> Maybe a
Just Char
x
                Char
_ -> forall a. Maybe a
Nothing
        -- Inside ",
        -- \\ is translated to \
        -- \" is translated to "
        trEsc :: Char -> Char -> Maybe Char
trEsc Char
'"' Char
x =
            case Char
x of
                Char
'\\' -> forall a. a -> Maybe a
Just Char
'\\'
                Char
'"' -> forall a. a -> Maybe a
Just Char
'"'
                Char
_ -> forall a. Maybe a
Nothing
        trEsc Char
_ Char
_ = forall a. Maybe a
Nothing
     in forall (m :: * -> *) a b.
(Monad m, Eq a) =>
Bool
-> (a -> a -> Maybe a)
-> a
-> (a -> Maybe a)
-> (a -> Bool)
-> Fold m a b
-> Parser a m b
Parser.wordWithQuotes Bool
False Char -> Char -> Maybe Char
trEsc Char
'\\' Char -> Maybe Char
toRQuote Char -> Bool
isSpace forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList

-- | A modifier for stream generation APIs in "Streamly.System.Process" to
-- generate streams from command strings.
--
-- For example:
--
-- >>> streamWith Process.toBytes "echo hello" & Stdio.putBytes
-- hello
-- >>> streamWith Process.toChunks "echo hello" & Stdio.putChunks
-- hello
--
-- /Internal/
{-# INLINE streamWith #-}
streamWith :: MonadCatch m =>
    (FilePath -> [String] -> Stream m a) -> String -> Stream m a
streamWith :: forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith String -> [String] -> Stream m a
f String
cmd =
    forall (m :: * -> *) a. Monad m => m (Stream m a) -> Stream m a
Stream.concatEffect forall a b. (a -> b) -> a -> b
$ do
        [String]
xs <- forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList
                forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
Stream m (Either a b) -> Stream m b
Stream.catRights
                forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
Stream.parseMany forall (m :: * -> *). MonadCatch m => Parser Char m String
quotedWord
                forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
Stream.fromList String
cmd
        case [String]
xs of
            String
y:[String]
ys -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> [String] -> Stream m a
f String
y [String]
ys
            [String]
_ -> forall a. HasCallStack => String -> a
error String
"streamWith: empty command"

-- | A modifier for process running APIs in "Streamly.System.Process" to run
-- command strings.
--
-- For example:
--
-- >>> runWith Process.toString "echo hello"
-- "hello\n"
-- >>> runWith Process.toStdout "echo hello"
-- hello
--
-- /Internal/
{-# INLINE runWith #-}
runWith :: MonadCatch m =>
    (FilePath -> [String] -> m a) -> String -> m a
runWith :: forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith String -> [String] -> m a
f String
cmd = do
    [String]
xs <- forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
Stream m (Either a b) -> Stream m b
Stream.catRights
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
Stream.parseMany forall (m :: * -> *). MonadCatch m => Parser Char m String
quotedWord
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
Stream.fromList String
cmd
    case [String]
xs of
        String
y:[String]
ys -> String -> [String] -> m a
f String
y [String]
ys
        [String]
_ -> forall a. HasCallStack => String -> a
error String
"streamWith: empty command"

-- | A modifier for process piping APIs in "Streamly.System.Process" to pipe
-- data through processes specified by command strings.
--
-- For example:
--
-- >>> :{
--    toChunks "echo hello"
--  & pipeWith Process.pipeChunks "tr [a-z] [A-Z]"
--  & Stdio.putChunks
--  :}
--HELLO
--
-- /Internal/
pipeWith :: MonadCatch m =>
       (FilePath -> [String] -> Stream m a -> Stream m b)
    -> String
    -> Stream m a
    -> Stream m b
pipeWith :: forall (m :: * -> *) a b.
MonadCatch m =>
(String -> [String] -> Stream m a -> Stream m b)
-> String -> Stream m a -> Stream m b
pipeWith String -> [String] -> Stream m a -> Stream m b
f String
cmd Stream m a
input =
    forall (m :: * -> *) a. Monad m => m (Stream m a) -> Stream m a
Stream.concatEffect forall a b. (a -> b) -> a -> b
$ do
        [String]
xs <- forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList
                forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
Stream m (Either a b) -> Stream m b
Stream.catRights
                forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
Stream.parseMany forall (m :: * -> *). MonadCatch m => Parser Char m String
quotedWord
                forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
Stream.fromList String
cmd
        case [String]
xs of
            String
y:[String]
ys -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> [String] -> Stream m a -> Stream m b
f String
y [String]
ys Stream m a
input
            [String]
_ -> forall a. HasCallStack => String -> a
error String
"streamWith: empty command"

-- | Like 'pipeChunks' but use the specified configuration to run the process.
{-# INLINE pipeChunksWith #-}
pipeChunksWith ::
    (MonadCatch m, MonadAsync m)
    => (Config -> Config)      -- ^ Config modifier
    -> String                  -- ^ Command
    -> Stream m (Array Word8)  -- ^ Input stream
    -> Stream m (Array Word8)  -- ^ Output stream
pipeChunksWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> String -> Stream m (Array Word8) -> Stream m (Array Word8)
pipeChunksWith Config -> Config
modifier = forall (m :: * -> *) a b.
MonadCatch m =>
(String -> [String] -> Stream m a -> Stream m b)
-> String -> Stream m a -> Stream m b
pipeWith (forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> String
-> [String]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
Process.pipeChunksWith Config -> Config
modifier)

-- | @pipeChunks command input@ runs the executable with arguments specified by
-- @command@ and supplying @input@ stream as its standard input.  Returns the
-- standard output of the executable as a stream of byte arrays.
--
-- If only the name of an executable file is specified instead of its path then
-- the file name is searched in the directories specified by the PATH
-- environment variable.
--
-- 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 'Process.ProcessFailure'
-- exception is raised.
--
-- The following code is equivalent to the shell command @echo "hello world" |
-- tr [a-z] [A-Z]@:
--
-- >>> :{
--    toChunks "echo hello world"
--  & pipeChunks "tr [a-z] [A-Z]"
--  & Stdio.putChunks
--  :}
--HELLO WORLD
--
-- /Pre-release/
{-# INLINE pipeChunks #-}
pipeChunks :: (MonadAsync m, MonadCatch m) =>
    String -> Stream m (Array Word8) -> Stream m (Array Word8)
pipeChunks :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> Stream m (Array Word8) -> Stream m (Array Word8)
pipeChunks = forall (m :: * -> *) a b.
MonadCatch m =>
(String -> [String] -> Stream m a -> Stream m b)
-> String -> Stream m a -> Stream m b
pipeWith forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
String
-> [String] -> Stream m (Array Word8) -> Stream m (Array Word8)
Process.pipeChunks

-- | Like 'pipeChunks' except that it works on a stream of bytes instead of
-- a stream of chunks.
--
-- >>> :{
--    toBytes "echo hello world"
--  & pipeBytes "tr [a-z] [A-Z]"
--  & Stdio.putBytes
--  :}
--HELLO WORLD
--
-- /Pre-release/
{-# INLINE pipeBytes #-}
pipeBytes :: (MonadAsync m, MonadCatch m) =>
    String -> Stream m Word8 -> Stream m Word8
pipeBytes :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> Stream m Word8 -> Stream m Word8
pipeBytes = forall (m :: * -> *) a b.
MonadCatch m =>
(String -> [String] -> Stream m a -> Stream m b)
-> String -> Stream m a -> Stream m b
pipeWith forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
String -> [String] -> Stream m Word8 -> Stream m Word8
Process.pipeBytes

-- | Like 'pipeChunks' except that it works on a stream of chars instead of
-- a stream of chunks.
--
-- >>> :{
--    toChars "echo hello world"
--  & pipeChars "tr [a-z] [A-Z]"
--  & Stdio.putChars
--  :}
--HELLO WORLD
--
-- /Pre-release/
{-# INLINE pipeChars #-}
pipeChars :: (MonadAsync m, MonadCatch m) =>
    String -> Stream m Char -> Stream m Char
pipeChars :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> Stream m Char -> Stream m Char
pipeChars = forall (m :: * -> *) a b.
MonadCatch m =>
(String -> [String] -> Stream m a -> Stream m b)
-> String -> Stream m a -> Stream m b
pipeWith forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
String -> [String] -> Stream m Char -> Stream m Char
Process.pipeChars

-------------------------------------------------------------------------------
-- Generation
-------------------------------------------------------------------------------

-- >>> toBytes = streamWith Process.toBytes

-- |
-- >>> toBytes "echo hello world" & Stdio.putBytes
--hello world
-- >>> toBytes "echo hello\\ world" & Stdio.putBytes
--hello world
-- >>> toBytes "echo 'hello world'" & Stdio.putBytes
--hello world
-- >>> toBytes "echo \"hello world\"" & Stdio.putBytes
--hello world
--
-- /Pre-release/
{-# INLINE toBytes #-}
toBytes :: (MonadAsync m, MonadCatch m) => String -> Stream m Word8
toBytes :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> Stream m Word8
toBytes = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> Stream m Word8
Process.toBytes

-- | Like 'toChunks' but use the specified configuration to run the process.
{-# INLINE toChunksWith #-}
toChunksWith ::
    (MonadCatch m, MonadAsync m)
    => (Config -> Config)     -- ^ Config modifier
    -> String                 -- ^ Command
    -> Stream m (Array Word8) -- ^ Output stream
toChunksWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config) -> String -> Stream m (Array Word8)
toChunksWith Config -> Config
modifier = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith (forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config) -> String -> [String] -> Stream m (Array Word8)
Process.toChunksWith Config -> Config
modifier)

-- >>> toChunks = streamWith Process.toChunks

-- |
-- >>> toChunks "echo hello world" & Stdio.putChunks
--hello world
--
-- /Pre-release/
{-# INLINE toChunks #-}
toChunks :: (MonadAsync m, MonadCatch m) => String -> Stream m (Array Word8)
toChunks :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> Stream m (Array Word8)
toChunks = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> Stream m (Array Word8)
Process.toChunks

-- >>> toChars = streamWith Process.toChars

-- |
-- >>> toChars "echo hello world" & Stdio.putChars
--hello world
--
-- /Pre-release/
{-# INLINE toChars #-}
toChars :: (MonadAsync m, MonadCatch m) => String -> Stream m Char
toChars :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> Stream m Char
toChars = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> Stream m Char
Process.toChars

-- >>> toLines f = streamWith (Process.toLines f)

-- |
-- >>> toLines Fold.toList "echo -e hello\\\\nworld" & Stream.fold Fold.toList
-- ["hello","world"]
--
-- /Pre-release/
{-# INLINE toLines #-}
toLines ::
    (MonadAsync m, MonadCatch m)
    => Fold m Char a
    -> String       -- ^ Command
    -> Stream m a -- ^ Output Stream
toLines :: forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m) =>
Fold m Char a -> String -> Stream m a
toLines Fold m Char a
f = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith (forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m) =>
Fold m Char a -> String -> [String] -> Stream m a
Process.toLines Fold m Char a
f)

-- >>> toString = runWith Process.toString

-- |
-- >>> toString "echo hello world"
--"hello world\n"
--
-- /Pre-release/
{-# INLINE toString #-}
toString ::
    (MonadAsync m, MonadCatch m)
    => String       -- ^ Command
    -> m String
toString :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> m String
toString = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> m String
Process.toString

-- >>> toStdout = runWith Process.toStdout

-- |
-- >>> toStdout "echo hello world"
-- hello world
--
-- /Pre-release/
{-# INLINE toStdout #-}
toStdout ::
    (MonadAsync m, MonadCatch m)
    => String       -- ^ Command
    -> m ()
toStdout :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> m ()
toStdout = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> m ()
Process.toStdout

-- >>> toNull = runWith Process.toNull

-- |
-- >>> toNull "echo hello world"
--
-- /Pre-release/
{-# INLINE toNull #-}
toNull ::
    (MonadAsync m, MonadCatch m)
    => String -- ^ Command
    -> m ()
toNull :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> m ()
toNull = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> m ()
Process.toNull

-------------------------------------------------------------------------------
-- Processes not interacting with the parent process
-------------------------------------------------------------------------------

-- | Launch a standlone 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?
    -> (Bool, Bool, Bool) -- ^ close (stdin, stdout, stderr)
    -> (Config -> Config)
    -> String -- ^ Command
    -> IO (Either ExitCode ProcessHandle)
standalone :: Bool
-> (Bool, Bool, Bool)
-> (Config -> Config)
-> String
-> IO (Either ExitCode ProcessHandle)
standalone Bool
wait (Bool, Bool, Bool)
streams Config -> Config
modCfg =
    forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith (Bool
-> (Bool, Bool, Bool)
-> (Config -> Config)
-> String
-> [String]
-> IO (Either ExitCode ProcessHandle)
Process.standalone Bool
wait (Bool, Bool, Bool)
streams Config -> Config
modCfg)

-- | 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 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)
    -> String -- ^ Command
    -> IO ExitCode
foreground :: (Config -> Config) -> String -> IO ExitCode
foreground Config -> Config
modCfg = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith ((Config -> Config) -> String -> [String] -> IO ExitCode
Process.foreground Config -> Config
modCfg)

-- | 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 ::
       (Config -> Config)
    -> String -- ^ Command
    -> IO ProcessHandle
daemon :: (Config -> Config) -> String -> IO ProcessHandle
daemon Config -> Config
modCfg = forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith ((Config -> Config) -> String -> [String] -> IO ProcessHandle
Process.daemon Config -> Config
modCfg)