{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
module Streamly.Internal.System.Command
(
toBytes
, toChunks
, toChunksWith
, toChars
, toLines
, toString
, toStdout
, toNull
, pipeBytes
, pipeChars
, pipeChunks
, pipeChunksWith
, standalone
, foreground
, daemon
, 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
#include "DocTestCommand.hs"
{-# 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
'"' -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
Char
'\'' -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
Char
_ -> Maybe Char
forall a. Maybe a
Nothing
trEsc :: Char -> Char -> Maybe Char
trEsc Char
'"' Char
x =
case Char
x of
Char
'\\' -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\'
Char
'"' -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'"'
Char
_ -> Maybe Char
forall a. Maybe a
Nothing
trEsc Char
_ Char
_ = Maybe Char
forall a. Maybe a
Nothing
in Bool
-> (Char -> Char -> Maybe Char)
-> Char
-> (Char -> Maybe Char)
-> (Char -> Bool)
-> Fold m Char String
-> Parser Char m String
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 Fold m Char String
forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList
{-# 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 =
m (Stream m a) -> Stream m a
forall (m :: * -> *) a. Monad m => m (Stream m a) -> Stream m a
Stream.concatEffect (m (Stream m a) -> Stream m a) -> m (Stream m a) -> Stream m a
forall a b. (a -> b) -> a -> b
$ do
[String]
xs <- Fold m String [String] -> Stream m String -> m [String]
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold Fold m String [String]
forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList
(Stream m String -> m [String]) -> Stream m String -> m [String]
forall a b. (a -> b) -> a -> b
$ Stream m (Either ParseError String) -> Stream m String
forall (m :: * -> *) a b.
Monad m =>
Stream m (Either a b) -> Stream m b
Stream.catRights
(Stream m (Either ParseError String) -> Stream m String)
-> Stream m (Either ParseError String) -> Stream m String
forall a b. (a -> b) -> a -> b
$ Parser Char m String
-> Stream m Char -> Stream m (Either ParseError String)
forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
Stream.parseMany Parser Char m String
forall (m :: * -> *). MonadCatch m => Parser Char m String
quotedWord
(Stream m Char -> Stream m (Either ParseError String))
-> Stream m Char -> Stream m (Either ParseError String)
forall a b. (a -> b) -> a -> b
$ String -> Stream m Char
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
Stream.fromList String
cmd
case [String]
xs of
String
y:[String]
ys -> Stream m a -> m (Stream m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m a -> m (Stream m a)) -> Stream m a -> m (Stream m a)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Stream m a
f String
y [String]
ys
[String]
_ -> String -> m (Stream m a)
forall a. HasCallStack => String -> a
error String
"streamWith: empty command"
{-# 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 <- Fold m String [String] -> Stream m String -> m [String]
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold Fold m String [String]
forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList
(Stream m String -> m [String]) -> Stream m String -> m [String]
forall a b. (a -> b) -> a -> b
$ Stream m (Either ParseError String) -> Stream m String
forall (m :: * -> *) a b.
Monad m =>
Stream m (Either a b) -> Stream m b
Stream.catRights
(Stream m (Either ParseError String) -> Stream m String)
-> Stream m (Either ParseError String) -> Stream m String
forall a b. (a -> b) -> a -> b
$ Parser Char m String
-> Stream m Char -> Stream m (Either ParseError String)
forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
Stream.parseMany Parser Char m String
forall (m :: * -> *). MonadCatch m => Parser Char m String
quotedWord
(Stream m Char -> Stream m (Either ParseError String))
-> Stream m Char -> Stream m (Either ParseError String)
forall a b. (a -> b) -> a -> b
$ String -> Stream m Char
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]
_ -> String -> m a
forall a. HasCallStack => String -> a
error String
"streamWith: empty command"
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 =
m (Stream m b) -> Stream m b
forall (m :: * -> *) a. Monad m => m (Stream m a) -> Stream m a
Stream.concatEffect (m (Stream m b) -> Stream m b) -> m (Stream m b) -> Stream m b
forall a b. (a -> b) -> a -> b
$ do
[String]
xs <- Fold m String [String] -> Stream m String -> m [String]
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold Fold m String [String]
forall (m :: * -> *) a. Monad m => Fold m a [a]
Fold.toList
(Stream m String -> m [String]) -> Stream m String -> m [String]
forall a b. (a -> b) -> a -> b
$ Stream m (Either ParseError String) -> Stream m String
forall (m :: * -> *) a b.
Monad m =>
Stream m (Either a b) -> Stream m b
Stream.catRights
(Stream m (Either ParseError String) -> Stream m String)
-> Stream m (Either ParseError String) -> Stream m String
forall a b. (a -> b) -> a -> b
$ Parser Char m String
-> Stream m Char -> Stream m (Either ParseError String)
forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
Stream.parseMany Parser Char m String
forall (m :: * -> *). MonadCatch m => Parser Char m String
quotedWord
(Stream m Char -> Stream m (Either ParseError String))
-> Stream m Char -> Stream m (Either ParseError String)
forall a b. (a -> b) -> a -> b
$ String -> Stream m Char
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
Stream.fromList String
cmd
case [String]
xs of
String
y:[String]
ys -> Stream m b -> m (Stream m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m b -> m (Stream m b)) -> Stream m b -> m (Stream m b)
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]
_ -> String -> m (Stream m b)
forall a. HasCallStack => String -> a
error String
"streamWith: empty command"
{-# INLINE pipeChunksWith #-}
pipeChunksWith ::
(MonadCatch m, MonadAsync m)
=> (Config -> Config)
-> String
-> Stream m (Array Word8)
-> Stream m (Array Word8)
pipeChunksWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> String -> Stream m (Array Word8) -> Stream m (Array Word8)
pipeChunksWith Config -> Config
modifier = (String
-> [String] -> Stream m (Array Word8) -> Stream m (Array Word8))
-> String -> Stream m (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *) a b.
MonadCatch m =>
(String -> [String] -> Stream m a -> Stream m b)
-> String -> Stream m a -> Stream m b
pipeWith ((Config -> Config)
-> String
-> [String]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config)
-> String
-> [String]
-> Stream m (Array Word8)
-> Stream m (Array Word8)
Process.pipeChunksWith Config -> Config
modifier)
{-# 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 = (String
-> [String] -> Stream m (Array Word8) -> Stream m (Array Word8))
-> String -> Stream m (Array Word8) -> Stream m (Array Word8)
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 (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
String
-> [String] -> Stream m (Array Word8) -> Stream m (Array Word8)
Process.pipeChunks
{-# 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 = (String -> [String] -> Stream m Word8 -> Stream m Word8)
-> String -> Stream m Word8 -> Stream m Word8
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 Word8 -> Stream m Word8
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
String -> [String] -> Stream m Word8 -> Stream m Word8
Process.pipeBytes
{-# 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 = (String -> [String] -> Stream m Char -> Stream m Char)
-> String -> Stream m Char -> Stream m Char
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 Char -> Stream m Char
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
String -> [String] -> Stream m Char -> Stream m Char
Process.pipeChars
{-# INLINE toBytes #-}
toBytes :: (MonadAsync m, MonadCatch m) => String -> Stream m Word8
toBytes :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> Stream m Word8
toBytes = (String -> [String] -> Stream m Word8) -> String -> Stream m Word8
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith String -> [String] -> Stream m Word8
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> Stream m Word8
Process.toBytes
{-# INLINE toChunksWith #-}
toChunksWith ::
(MonadCatch m, MonadAsync m)
=> (Config -> Config)
-> String
-> Stream m (Array Word8)
toChunksWith :: forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config) -> String -> Stream m (Array Word8)
toChunksWith Config -> Config
modifier = (String -> [String] -> Stream m (Array Word8))
-> String -> Stream m (Array Word8)
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith ((Config -> Config) -> String -> [String] -> Stream m (Array Word8)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m) =>
(Config -> Config) -> String -> [String] -> Stream m (Array Word8)
Process.toChunksWith Config -> Config
modifier)
{-# 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 = (String -> [String] -> Stream m (Array Word8))
-> String -> Stream m (Array Word8)
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith String -> [String] -> Stream m (Array Word8)
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> Stream m (Array Word8)
Process.toChunks
{-# INLINE toChars #-}
toChars :: (MonadAsync m, MonadCatch m) => String -> Stream m Char
toChars :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> Stream m Char
toChars = (String -> [String] -> Stream m Char) -> String -> Stream m Char
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith String -> [String] -> Stream m Char
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> Stream m Char
Process.toChars
{-# INLINE toLines #-}
toLines ::
(MonadAsync m, MonadCatch m)
=> Fold m Char a
-> String
-> Stream m a
toLines :: forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m) =>
Fold m Char a -> String -> Stream m a
toLines Fold m Char a
f = (String -> [String] -> Stream m a) -> String -> Stream m a
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> Stream m a) -> String -> Stream m a
streamWith (Fold m Char a -> String -> [String] -> Stream m a
forall (m :: * -> *) a.
(MonadAsync m, MonadCatch m) =>
Fold m Char a -> String -> [String] -> Stream m a
Process.toLines Fold m Char a
f)
{-# INLINE toString #-}
toString ::
(MonadAsync m, MonadCatch m)
=> String
-> m String
toString :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> m String
toString = (String -> [String] -> m String) -> String -> m String
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith String -> [String] -> m String
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> m String
Process.toString
{-# INLINE toStdout #-}
toStdout ::
(MonadAsync m, MonadCatch m)
=> String
-> m ()
toStdout :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> m ()
toStdout = (String -> [String] -> m ()) -> String -> m ()
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith String -> [String] -> m ()
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> m ()
Process.toStdout
{-# INLINE toNull #-}
toNull ::
(MonadAsync m, MonadCatch m)
=> String
-> m ()
toNull :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> m ()
toNull = (String -> [String] -> m ()) -> String -> m ()
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith String -> [String] -> m ()
forall (m :: * -> *).
(MonadAsync m, MonadCatch m) =>
String -> [String] -> m ()
Process.toNull
{-# INLINE standalone #-}
standalone ::
Bool
-> (Bool, Bool, Bool)
-> (Config -> Config)
-> String
-> 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 =
(String -> [String] -> IO (Either ExitCode ProcessHandle))
-> String -> IO (Either ExitCode ProcessHandle)
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)
{-# INLINE foreground #-}
foreground ::
(Config -> Config)
-> String
-> IO ExitCode
foreground :: (Config -> Config) -> String -> IO ExitCode
foreground Config -> Config
modCfg = (String -> [String] -> IO ExitCode) -> String -> IO ExitCode
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith ((Config -> Config) -> String -> [String] -> IO ExitCode
Process.foreground Config -> Config
modCfg)
{-# INLINE daemon #-}
daemon ::
(Config -> Config)
-> String
-> IO ProcessHandle
daemon :: (Config -> Config) -> String -> IO ProcessHandle
daemon Config -> Config
modCfg = (String -> [String] -> IO ProcessHandle)
-> String -> IO ProcessHandle
forall (m :: * -> *) a.
MonadCatch m =>
(String -> [String] -> m a) -> String -> m a
runWith ((Config -> Config) -> String -> [String] -> IO ProcessHandle
Process.daemon Config -> Config
modCfg)