-- |
-- 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
    , toChars
    , toLines

    -- * Effects
    , toString
    , toStdout
    , toNull

    -- * Transformation
    , pipeBytes
    , pipeChars
    , pipeChunks

    -- * Helpers
    , 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 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

-- $setup
-- >>> :set -XFlexibleContexts
-- >>> :set -XQuasiQuotes
-- >>> import Data.Char (toUpper)
-- >>> import Data.Function ((&))
-- >>> import Streamly.Unicode.String (str)
-- >>> import qualified Streamly.Data.Array as Array
-- >>> import qualified Streamly.Console.Stdio as Stdio
-- >>> import qualified Streamly.Data.Fold as Fold
-- >>> import qualified Streamly.Data.Stream.Prelude as Stream
-- >>> import qualified Streamly.System.Command as Command
-- >>> import qualified Streamly.Unicode.Stream as Unicode
--
-- >>> import qualified Streamly.Internal.System.Process as Process
-- >>> import qualified Streamly.Internal.Console.Stdio as Stdio
-- >>> import qualified Streamly.Internal.FileSystem.Dir as Dir

{-# 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
        trEsc :: a -> a -> Maybe a
trEsc a
q a
x = if a
q forall a. Eq a => a -> a -> Bool
== a
x then forall a. a -> Maybe a
Just a
x else 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 forall {a}. Eq a => a -> a -> Maybe a
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"


-- | @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 '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

-- |
--
-- >>> 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