Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
This module contains a few functions to use unix-y shell commands
as Pipe
s.
The output ByteString
s from pipeCmdEnv
and friends are not line-wise,
but chunk-wise. To get proper lines
use the pipes-bytestring and the upcoming pipes-text machinery.
All code examples in this module assume following qualified imports: Pipes.Prelude as P, Pipes.ByteString as PBS, Data.ByteString.Char8 as BSC
- pipeCmdEnv :: MonadSafe m => Maybe [(String, String)] -> String -> Pipe (Maybe ByteString) (Either ByteString ByteString) m ()
- pipeCmd :: MonadSafe m => String -> Pipe (Maybe ByteString) (Either ByteString ByteString) m ()
- pipeCmd' :: MonadSafe m => String -> Pipe (Maybe ByteString) ByteString m ()
- producerCmdEnv :: MonadSafe m => Maybe [(String, String)] -> String -> Producer (Either ByteString ByteString) m ()
- producerCmd :: MonadSafe m => String -> Producer (Either ByteString ByteString) m ()
- producerCmd' :: MonadSafe m => String -> Producer ByteString m ()
- consumerCmdEnv :: MonadSafe m => Maybe [(String, String)] -> String -> Consumer (Maybe ByteString) m ()
- consumerCmd :: MonadSafe m => String -> Consumer (Maybe ByteString) m ()
- class Cmd cmd where
- class Cmd' cmd where
- (>?>) :: Monad m => Proxy a' a () b m r -> Proxy () (Maybe b) c' c m r -> Proxy a' a c' c m r
- markEnd :: Monad m => Proxy a' a b' b m r -> Proxy a' a b' (Maybe b) m r
- ignoreErr :: Monad m => Pipe (Either ByteString ByteString) ByteString m ()
- ignoreOut :: Monad m => Pipe (Either ByteString ByteString) ByteString m ()
- runShell :: Effect (SafeT IO) r -> IO r
Basic combinators
pipeCmdEnv :: MonadSafe m => Maybe [(String, String)] -> String -> Pipe (Maybe ByteString) (Either ByteString ByteString) m () Source
This is the workhorse of this package.
It provides the direct interface from a shell command string to a proper
Pipe
.
>>>
runShell $ yield (BSC.pack "aaa") >?> pipeCmdEnv Nothing "tr 'a' 'A'" >-> PBS.stdout
AAA
pipeCmd :: MonadSafe m => String -> Pipe (Maybe ByteString) (Either ByteString ByteString) m () Source
Like pipeCmdEnv
but doesn't set enviorment varaibles
pipeCmd' :: MonadSafe m => String -> Pipe (Maybe ByteString) ByteString m () Source
Like pipeCmd
but ignores stderr
producerCmdEnv :: MonadSafe m => Maybe [(String, String)] -> String -> Producer (Either ByteString ByteString) m () Source
Like pipeCmdEnv
but closes the input end immediately.
Useful for command line tools like ls
producerCmd :: MonadSafe m => String -> Producer (Either ByteString ByteString) m () Source
Like producerCmdEnv
but doesn't set enviorment varaibles
producerCmd' :: MonadSafe m => String -> Producer ByteString m () Source
Like producerCmd
but ignores stderr
consumerCmdEnv :: MonadSafe m => Maybe [(String, String)] -> String -> Consumer (Maybe ByteString) m () Source
Like pipeCmd
but closes the output end immediately.
Useful for command line tools like cat > test.file
consumerCmd :: MonadSafe m => String -> Consumer (Maybe ByteString) m () Source
Like consumerCmdEnv
but doesn't set enviorment varaibles
Fancy overloads
An ad-hoc typeclass to get the varadic arguments and DWIM behavoir of cmdEnv
cmdEnv :: Maybe [(String, String)] -> String -> cmd Source
Like pipeCmdEnv
, producerCmdEnv
or consumerCmdEnv
depending on the context. It also supports varadic arguments.
Examples:
As Pipe
:
>>>
runShell $ yield (BSC.pack "aaa") >?> cmd "tr 'a' 'A'" >-> ignoreErr >-> PBS.stdout
AAA
As Producer
:
>>>
runShell $ cmd "ls" >-> ignoreErr >-> PBS.stdout
<output from ls on the current directory>
As Consumer
:
>>>
runShell $ yield (BSC.pack "aaa") >?> cmd "cat > test.file"
<a new file with "aaa" in it>
cmd :: Cmd cmd => String -> cmd Source
Like cmdEnv
but doesn't set enviorment varaibles
Cmd cmd => Cmd (String -> cmd) | |
MonadSafe m => Cmd (Producer (Either ByteString ByteString) m ()) | |
MonadSafe m => Cmd (Consumer (Maybe ByteString) m ()) | |
MonadSafe m => Cmd (Pipe (Maybe ByteString) (Either ByteString ByteString) m ()) |
An ad-hoc typeclass to get the varadic arguments and DWIM behavoir of cmd'
.
This class is seperate from Cmd
to make the return types work out.
Like cmd
but uses ignoreErr
automatically.
So it's like pipeCmd'
, producerCmd'
or consumerCmd
depending on context.
It supports the same style of varadic arguments as cmd
Cmd' cmd => Cmd' (String -> cmd) | |
MonadSafe m => Cmd' (Producer ByteString m ()) | |
MonadSafe m => Cmd' (Consumer (Maybe ByteString) m ()) | |
MonadSafe m => Cmd' (Pipe (Maybe ByteString) ByteString m ()) |
Utils
(>?>) :: Monad m => Proxy a' a () b m r -> Proxy () (Maybe b) c' c m r -> Proxy a' a c' c m r infixl 7 Source
Like >->
but marks the end of the left pipe with markEnd
.
It's needed because pipeCmdEnv
has to know when
the upstream Pipe
finishes.
The basic rule is:
Replace every>->
with>?>
when it's in front ofpipeCmdEnv
or similar.
ignoreErr :: Monad m => Pipe (Either ByteString ByteString) ByteString m () Source
Ignore stderr from a pipeCmd
ignoreOut :: Monad m => Pipe (Either ByteString ByteString) ByteString m () Source
Ignore stdout from a pipeCmd