Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
- Entering Sh
- Running external commands
- Running commands Using handles
- Modifying and querying environment
- Environment directory
- Printing
- Querying filesystem
- Filename helpers
- Manipulating filesystem
- reading/writing Files
- exiting the program
- Exceptions
- convert between Text and FilePath
- Utility Functions
- Re-exported for your convenience
- internal functions for writing extensions
- find functions
- Orphan instances
A module for shell-like programming in Haskell. Shelly's focus is entirely on ease of use for those coming from shell scripting. However, it also tries to use modern libraries and techniques to keep things efficient.
The functionality provided by this module is (unlike standard Haskell filesystem functionality) thread-safe: each Sh maintains its own environment and its own working directory.
Recommended usage includes putting the following at the top of your program, otherwise you will likely need either type annotations or type conversions
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} import Shelly import qualified Data.Text as T default (T.Text)
Synopsis
- class Monad m => MonadSh m where
- class Monad m => MonadShControl m where
- data Sh a
- type ShIO a = Sh a
- shelly :: MonadIO m => Sh a -> m a
- shellyNoDir :: MonadIO m => Sh a -> m a
- shellyFailDir :: MonadIO m => Sh a -> m a
- sub :: MonadShControl m => m a -> m a
- silently :: MonadShControl m => m a -> m a
- verbosely :: MonadShControl m => m a -> m a
- escaping :: MonadShControl m => Bool -> m a -> m a
- print_stdout :: MonadShControl m => Bool -> m a -> m a
- print_stderr :: MonadShControl m => Bool -> m a -> m a
- print_commands :: MonadShControl m => Bool -> m a -> m a
- tracing :: MonadShControl m => Bool -> m a -> m a
- errExit :: MonadShControl m => Bool -> m a -> m a
- log_stdout_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a
- log_stderr_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a
- run :: MonadSh m => FilePath -> [Text] -> m Text
- run_ :: MonadSh m => FilePath -> [Text] -> m ()
- runFoldLines :: MonadSh m => a -> FoldCallback a -> FilePath -> [Text] -> m a
- cmd :: ShellCmd result => FilePath -> result
- type FoldCallback a = a -> Text -> a
- (-|-) :: (MonadShControl m, MonadSh m) => m Text -> m b -> m b
- lastStderr :: MonadSh m => m Text
- setStdin :: MonadSh m => Text -> m ()
- lastExitCode :: MonadSh m => m Int
- command :: MonadSh m => FilePath -> [Text] -> [Text] -> m Text
- command_ :: MonadSh m => FilePath -> [Text] -> [Text] -> m ()
- command1 :: MonadSh m => FilePath -> [Text] -> Text -> [Text] -> m Text
- command1_ :: MonadSh m => FilePath -> [Text] -> Text -> [Text] -> m ()
- sshPairs :: MonadSh m => Text -> [(FilePath, [Text])] -> m Text
- sshPairs_ :: MonadSh m => Text -> [(FilePath, [Text])] -> m ()
- class ShellCmd t where
- class CmdArg a where
- runHandle :: MonadShControl m => FilePath -> [Text] -> (Handle -> m a) -> m a
- runHandles :: MonadShControl m => FilePath -> [Text] -> [StdHandle] -> (Handle -> Handle -> Handle -> m a) -> m a
- transferLinesAndCombine :: MonadIO m => Handle -> (Text -> IO ()) -> m Text
- transferFoldHandleLines :: a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
- data StdHandle
- data StdStream
- setenv :: MonadSh m => Text -> Text -> m ()
- get_env :: MonadSh m => Text -> m (Maybe Text)
- get_env_text :: MonadSh m => Text -> m Text
- get_env_all :: MonadSh m => m [(String, String)]
- appendToPath :: MonadSh m => FilePath -> m ()
- prependToPath :: MonadSh m => FilePath -> m ()
- cd :: MonadSh m => FilePath -> m ()
- chdir :: MonadShControl m => FilePath -> m a -> m a
- chdir_p :: MonadShControl m => FilePath -> m a -> m a
- pwd :: MonadSh m => m FilePath
- echo :: MonadSh m => Text -> m ()
- echo_n :: MonadSh m => Text -> m ()
- echo_err :: MonadSh m => Text -> m ()
- echo_n_err :: MonadSh m => Text -> m ()
- inspect :: (Show s, MonadSh m) => s -> m ()
- inspect_err :: (Show s, MonadSh m) => s -> m ()
- tag :: (MonadShControl m, MonadSh m) => m a -> Text -> m a
- trace :: MonadSh m => Text -> m ()
- show_command :: FilePath -> [Text] -> Text
- ls :: MonadSh m => FilePath -> m [FilePath]
- lsT :: MonadSh m => FilePath -> m [Text]
- test_e :: MonadSh m => FilePath -> m Bool
- test_f :: MonadSh m => FilePath -> m Bool
- test_d :: MonadSh m => FilePath -> m Bool
- test_s :: MonadSh m => FilePath -> m Bool
- test_px :: MonadSh m => FilePath -> m Bool
- which :: MonadSh m => FilePath -> m (Maybe FilePath)
- absPath :: MonadSh m => FilePath -> m FilePath
- (</>) :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> FilePath
- (<.>) :: ToFilePath filepath => filepath -> Text -> FilePath
- canonic :: MonadSh m => FilePath -> m FilePath
- canonicalize :: MonadSh m => FilePath -> m FilePath
- relPath :: MonadSh m => FilePath -> m FilePath
- relativeTo :: MonadSh m => FilePath -> FilePath -> m FilePath
- hasExt :: Text -> FilePath -> Bool
- mv :: MonadSh m => FilePath -> FilePath -> m ()
- rm :: MonadSh m => FilePath -> m ()
- rm_f :: MonadSh m => FilePath -> m ()
- rm_rf :: MonadSh m => FilePath -> m ()
- cp :: MonadSh m => FilePath -> FilePath -> m ()
- cp_r :: MonadSh m => FilePath -> FilePath -> m ()
- mkdir :: MonadSh m => FilePath -> m ()
- mkdir_p :: MonadSh m => FilePath -> m ()
- mkdirTree :: MonadSh m => Tree FilePath -> m ()
- readfile :: MonadSh m => FilePath -> m Text
- readBinary :: MonadSh m => FilePath -> m ByteString
- writefile :: MonadSh m => FilePath -> Text -> m ()
- appendfile :: MonadSh m => FilePath -> Text -> m ()
- touchfile :: MonadSh m => FilePath -> m ()
- withTmpDir :: MonadShControl m => (FilePath -> m a) -> m a
- exit :: MonadSh m => Int -> m a
- errorExit :: MonadSh m => Text -> m a
- quietExit :: MonadSh m => Int -> m a
- terror :: MonadSh m => Text -> m a
- bracket_sh :: Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
- catchany :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a
- catch_sh :: Exception e => Sh a -> (e -> Sh a) -> Sh a
- handle_sh :: Exception e => (e -> Sh a) -> Sh a -> Sh a
- handleany_sh :: (SomeException -> Sh a) -> Sh a -> Sh a
- finally_sh :: Sh a -> Sh b -> Sh a
- catches_sh :: Sh a -> [Handler Sh a] -> Sh a
- catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a
- toTextIgnore :: FilePath -> Text
- toTextWarn :: MonadSh m => FilePath -> m Text
- fromText :: Text -> FilePath
- whenM :: Monad m => m Bool -> m () -> m ()
- unlessM :: Monad m => m Bool -> m () -> m ()
- time :: MonadShControl m => m a -> m (Double, a)
- sleep :: MonadSh m => Int -> m ()
- liftIO :: MonadIO m => IO a -> m a
- when :: Applicative f => Bool -> f () -> f ()
- unless :: Applicative f => Bool -> f () -> f ()
- type FilePath = String
- (<$>) :: Functor f => (a -> b) -> f a -> f b
- get :: MonadSh m => m State
- put :: MonadSh m => State -> m ()
- find :: FilePath -> Sh [FilePath]
- findWhen :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath]
- findFold :: (a -> FilePath -> Sh a) -> a -> FilePath -> Sh a
- findDirFilter :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath]
- findDirFilterWhen :: (FilePath -> Sh Bool) -> (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath]
- findFoldDirFilter :: (a -> FilePath -> Sh a) -> a -> (FilePath -> Sh Bool) -> FilePath -> Sh a
- followSymlink :: MonadShControl m => Bool -> m a -> m a
Documentation
class Monad m => MonadSh m where Source #
Instances
MonadSh Sh Source # | |
MonadSh m => MonadSh (MaybeT m) Source # | |
MonadSh m => MonadSh (ExceptT e m) Source # | |
MonadSh m => MonadSh (IdentityT m) Source # | |
MonadSh m => MonadSh (ReaderT r m) Source # | |
MonadSh m => MonadSh (StateT s m) Source # | |
MonadSh m => MonadSh (StateT s m) Source # | |
(Monoid w, MonadSh m) => MonadSh (WriterT w m) Source # | |
(Monoid w, MonadSh m) => MonadSh (WriterT w m) Source # | |
MonadSh m => MonadSh (ContT r m) Source # | |
(Monoid w, MonadSh m) => MonadSh (RWST r w s m) Source # | |
(Monoid w, MonadSh m) => MonadSh (RWST r w s m) Source # | |
class Monad m => MonadShControl m where Source #
Instances
MonadShControl Sh Source # | |
MonadShControl m => MonadShControl (MaybeT m) Source # | |
MonadShControl m => MonadShControl (ExceptT e m) Source # | |
MonadShControl m => MonadShControl (IdentityT m) Source # | |
MonadShControl m => MonadShControl (ReaderT r m) Source # | |
MonadShControl m => MonadShControl (StateT s m) Source # | |
MonadShControl m => MonadShControl (StateT s m) Source # | |
(MonadShControl m, Monoid w) => MonadShControl (WriterT w m) Source # | |
(MonadShControl m, Monoid w) => MonadShControl (WriterT w m) Source # | |
(MonadShControl m, Monoid w) => MonadShControl (RWST r w s m) Source # | |
(MonadShControl m, Monoid w) => MonadShControl (RWST r w s m) Source # | |
Entering Sh
Instances
MonadFail Sh Source # | |
Defined in Shelly.Base | |
MonadIO Sh Source # | |
Defined in Shelly.Base | |
Applicative Sh Source # | |
Functor Sh Source # | |
Monad Sh Source # | |
MonadCatch Sh Source # | |
MonadMask Sh Source # | |
MonadThrow Sh Source # | |
Defined in Shelly.Base | |
MonadSh Sh Source # | |
MonadShControl Sh Source # | |
MonadBaseControl IO Sh Source # | |
MonadBase IO Sh Source # | |
Defined in Shelly.Base | |
ShellCmd (Sh Text) Source # | |
ShellCmd (Sh ()) Source # | |
(s ~ Text, Show s) => ShellCmd (Sh s) Source # | |
newtype ShM Sh a Source # | |
Defined in Shelly.Lifted | |
type StM Sh a Source # | |
Defined in Shelly.Base |
Deprecated: Use Sh instead of ShIO
ShIO is Deprecated in favor of Sh
, which is easier to type.
shelly :: MonadIO m => Sh a -> m a Source #
Enter a Sh from (Monad)IO. The environment and working directories are inherited from the current process-wide values. Any subsequent changes in processwide working directory or environment are not reflected in the running Sh.
shellyNoDir :: MonadIO m => Sh a -> m a Source #
Deprecated: Just use shelly. The default settings have changed
Deprecated now, just use shelly
, whose default has been changed.
Using this entry point does not create a .shelly
directory in the case
of failure. Instead it logs directly into the standard error stream (stderr
).
shellyFailDir :: MonadIO m => Sh a -> m a Source #
Using this entry point creates a .shelly
directory in the case
of failure where errors are recorded.
sub :: MonadShControl m => m a -> m a Source #
silently :: MonadShControl m => m a -> m a Source #
verbosely :: MonadShControl m => m a -> m a Source #
escaping :: MonadShControl m => Bool -> m a -> m a Source #
print_stdout :: MonadShControl m => Bool -> m a -> m a Source #
print_stderr :: MonadShControl m => Bool -> m a -> m a Source #
print_commands :: MonadShControl m => Bool -> m a -> m a Source #
tracing :: MonadShControl m => Bool -> m a -> m a Source #
errExit :: MonadShControl m => Bool -> m a -> m a Source #
log_stdout_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a Source #
log_stderr_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a Source #
Running external commands
runFoldLines :: MonadSh m => a -> FoldCallback a -> FilePath -> [Text] -> m a Source #
cmd :: ShellCmd result => FilePath -> result Source #
Variadic argument version of run
.
Please see the documenation for run
.
The syntax is more convenient, but more importantly
it also allows the use of a FilePath
as a command argument.
So an argument can be a Text
or a FilePath
without manual conversions.
a FilePath
is automatically converted to Text
with toTextIgnore
.
Convenient usage of cmd
requires the following:
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} import Shelly import qualified Data.Text as T default (T.Text)
type FoldCallback a = a -> Text -> a Source #
lastStderr :: MonadSh m => m Text Source #
lastExitCode :: MonadSh m => m Int Source #
class ShellCmd t where Source #
For the variadic function cmd
.
Partially applied variadic functions require type signatures.
Instances
ShellCmd (Sh Text) Source # | |
ShellCmd (Sh ()) Source # | |
(s ~ Text, Show s) => ShellCmd (Sh s) Source # | |
MonadSh m => ShellCmd (m Text) Source # | |
MonadSh m => ShellCmd (m ()) Source # | |
(MonadSh m, s ~ Text, Show s) => ShellCmd (m s) Source # | |
(CmdArg arg, ShellCmd result) => ShellCmd ([arg] -> result) Source # | |
(CmdArg arg, ShellCmd result) => ShellCmd (arg -> result) Source # | |
Running commands Using handles
:: MonadShControl m | |
=> FilePath | command |
-> [Text] | arguments |
-> (Handle -> m a) | stdout handle |
-> m a |
transferFoldHandleLines :: a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a Source #
Transfer from one handle to another For example, send contents of a process output to stdout. Does not close the write handle.
Also, fold over the contents being streamed line by line.
Inherit | Inherit Handle from parent |
UseHandle Handle | Use the supplied Handle |
CreatePipe | Create a new pipe. The returned
|
NoStream | Close the stream's file descriptor without
passing a Handle. On POSIX systems this may
lead to strange behavior in the child process
because attempting to read or write after the
file has been closed throws an error. This
should only be used with child processes that
don't use the file descriptor at all. If you
wish to ignore the child process's output you
should either create a pipe and drain it
manually or pass a |
Modifying and querying environment
appendToPath :: MonadSh m => FilePath -> m () Source #
prependToPath :: MonadSh m => FilePath -> m () Source #
Environment directory
chdir :: MonadShControl m => FilePath -> m a -> m a Source #
chdir_p :: MonadShControl m => FilePath -> m a -> m a Source #
Printing
echo_n_err :: MonadSh m => Text -> m () Source #
inspect_err :: (Show s, MonadSh m) => s -> m () Source #
Querying filesystem
Filename helpers
(</>) :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> FilePath Source #
Uses System.FilePath, but can automatically convert a Text
.
(<.>) :: ToFilePath filepath => filepath -> Text -> FilePath Source #
Uses System.FilePath, but can automatically convert a Text
.
canonicalize :: MonadSh m => FilePath -> m FilePath Source #
Obtain a (reasonably) canonic file path to a filesystem object. Based on "canonicalizePath".
Manipulating filesystem
reading/writing Files
readBinary :: MonadSh m => FilePath -> m ByteString Source #
withTmpDir :: MonadShControl m => (FilePath -> m a) -> m a Source #
exiting the program
Exceptions
bracket_sh :: Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c Source #
Deprecated: use Control.Exception.Lifted.bracket instead
catchany :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a Source #
catch_sh :: Exception e => Sh a -> (e -> Sh a) -> Sh a Source #
Deprecated: use Control.Exception.Lifted.catch instead
handle_sh :: Exception e => (e -> Sh a) -> Sh a -> Sh a Source #
Deprecated: use Control.Exception.Lifted.handle instead
handleany_sh :: (SomeException -> Sh a) -> Sh a -> Sh a Source #
Deprecated: use Control.Exception.Enclosed.handleAny instead
catches_sh :: Sh a -> [Handler Sh a] -> Sh a Source #
Deprecated: use Control.Exception.Lifted.catches instead
catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a Source #
Deprecated: use Control.Exception.Enclosed.catchAny instead
convert between Text and FilePath
toTextIgnore :: FilePath -> Text Source #
Utility Functions
unlessM :: Monad m => m Bool -> m () -> m () Source #
A monadic-conditional version of the unless
guard.
time :: MonadShControl m => m a -> m (Double, a) Source #
Re-exported for your convenience
liftIO :: MonadIO m => IO a -> m a #
Lift a computation from the IO
monad.
This allows us to run IO computations in any monadic stack, so long as it supports these kinds of operations
(i.e. IO
is the base monad for the stack).
Example
import Control.Monad.Trans.State -- from the "transformers" library printState :: Show s => StateT s IO () printState = do state <- get liftIO $ print state
Had we omitted
, we would have ended up with this error:liftIO
• Couldn't match type ‘IO’ with ‘StateT s IO’ Expected type: StateT s IO () Actual type: IO ()
The important part here is the mismatch between StateT s IO ()
and
.IO
()
Luckily, we know of a function that takes an
and returns an IO
a(m a)
:
,
enabling us to run the program and see the expected results:liftIO
> evalStateT printState "hello" "hello" > evalStateT printState 3 3
when :: Applicative f => Bool -> f () -> f () #
Conditional execution of Applicative
expressions. For example,
when debug (putStrLn "Debugging")
will output the string Debugging
if the Boolean value debug
is True
, and otherwise do nothing.
unless :: Applicative f => Bool -> f () -> f () #
The reverse of when
.
File and directory names are values of type String
, whose precise
meaning is operating system dependent. Files can be opened, yielding a
handle which can then be used to operate on the contents of that file.
(<$>) :: Functor f => (a -> b) -> f a -> f b infixl 4 #
An infix synonym for fmap
.
The name of this operator is an allusion to $
.
Note the similarities between their types:
($) :: (a -> b) -> a -> b (<$>) :: Functor f => (a -> b) -> f a -> f b
Whereas $
is function application, <$>
is function
application lifted over a Functor
.
Examples
Convert from a
to a Maybe
Int
using Maybe
String
show
:
>>>
show <$> Nothing
Nothing>>>
show <$> Just 3
Just "3"
Convert from an
to an
Either
Int
Int
Either
Int
String
using show
:
>>>
show <$> Left 17
Left 17>>>
show <$> Right 17
Right "17"
Double each element of a list:
>>>
(*2) <$> [1,2,3]
[2,4,6]
Apply even
to the second element of a pair:
>>>
even <$> (2,2)
(2,True)
internal functions for writing extensions
find functions
find :: FilePath -> Sh [FilePath] Source #
List directory recursively (like the POSIX utility "find"). listing is relative if the path given is relative. If you want to filter out some results or fold over them you can do that with the returned files. A more efficient approach is to use one of the other find functions.
findWhen :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath] Source #
find
that filters the found files as it finds.
Files must satisfy the given filter to be returned in the result.
findDirFilter :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath] Source #
find
that filters out directories as it finds.
Filtering out directories can make a find much more efficient by avoiding entire trees of files.
:: (FilePath -> Sh Bool) | directory filter |
-> (FilePath -> Sh Bool) | file filter |
-> FilePath | directory |
-> Sh [FilePath] |
Similar to findWhen
, but also filter out directories.
Alternatively, similar to findDirFilter
, but also filter out files.
Filtering out directories makes the find much more efficient.
findFoldDirFilter :: (a -> FilePath -> Sh a) -> a -> (FilePath -> Sh Bool) -> FilePath -> Sh a Source #
Like findDirFilterWhen
but use a folding function rather than a filter.
The most general finder: you likely want a more specific one.
followSymlink :: MonadShControl m => Bool -> m a -> m a Source #