shelly-1.3.0.0: shell-like (systems) programming in Haskell

Safe HaskellNone

Shelly

Contents

Description

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

Entering Sh.

type ShIO a = Sh aSource

ShIO is Deprecated in favor of Sh, which is easier to type.

shelly :: MonadIO m => Sh a -> m aSource

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 aSource

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

sub :: Sh a -> Sh aSource

Enter a sub-Sh that inherits the environment The original state will be restored when the sub-Sh completes. Exceptions are propagated normally.

silently :: Sh a -> Sh aSource

Create a sub-Sh in which external command outputs are not echoed and commands are not printed. See sub.

verbosely :: Sh a -> Sh aSource

Create a sub-Sh in which external command outputs are echoed and Executed commands are printed See sub.

escaping :: Bool -> Sh a -> Sh aSource

Create a sub-Sh with shell character escaping on or off. Defaults to True.

Setting to False allows for shell wildcard such as * to be expanded by the shell along with any other special shell characters. As a side-effect, setting to False causes changes to PATH to be ignored: see the run documentation.

print_stdout :: Bool -> Sh a -> Sh aSource

Create a sub-Sh with stdout printing on or off Defaults to True.

print_commands :: Bool -> Sh a -> Sh aSource

Create a sub-Sh with command echoing on or off Defaults to False, set to True by verbosely

tracing :: Bool -> Sh a -> Sh aSource

Create a sub-Sh where commands are not traced Defaults to True. You should only set to False temporarily for very specific reasons

errExit :: Bool -> Sh a -> Sh aSource

named after bash -e errexit. Defaults to True. When True, throw an exception on a non-zero exit code. When False, ignore a non-zero exit code. Not recommended to set to False unless you are specifically checking the error code with lastExitCode.

Running external commands.

run :: FilePath -> [Text] -> Sh TextSource

Execute an external command. Takes the command name and arguments.

You may prefer using cmd instead, which is a variadic argument version of this function.

stdout and stderr are collected. The stdout is returned as a result of run, and complete stderr output is available after the fact using lastStderr

All of the stdout output will be loaded into memory. You can avoid this if you don't need stdout by using run_, If you want to avoid the memory and need to process the output then use runFoldLines or runHandle or runHandles.

By default shell characters are escaped and the command name is a name of a program that can be found via PATH. Shelly will look through the PATH itself to find the command.

When escaping is set to False, shell characters are allowed. Since there is no longer a guarantee that a single program name is given, Shelly cannot look in the PATH for it. a PATH modified by setenv is not taken into account when finding the exe name. Instead the original Haskell program PATH is used. On a Posix system the env command can be used to make the setenv PATH used when escaping is set to False. env echo hello instead of echo hello

run_ :: FilePath -> [Text] -> Sh ()Source

the same as run, but return () instead of the stdout content stdout will be read and discarded line-by-line

runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> Sh aSource

used by run. fold over stdout line-by-line as it is read to avoid keeping it in memory stderr is still being placed in memory under the assumption it is always relatively small

cmd :: ShellCommand result => FilePath -> resultSource

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

(-|-) :: Sh Text -> Sh b -> Sh bSource

Pipe operator. set the stdout the first command as the stdin of the second. This does not create a shell-level pipe, but hopefully it will in the future. To create a shell level pipe you can set escaping False and use a pipe | character in a command.

lastStderr :: Sh TextSource

The output of last external command. See run.

setStdin :: Text -> Sh ()Source

set the stdin to be used and cleared by the next run.

lastExitCode :: Sh IntSource

The exit code from the last command. Unless you set errExit to False you won't get a chance to use this: a non-zero exit code will throw an exception.

command :: FilePath -> [Text] -> [Text] -> Sh TextSource

bind some arguments to run for re-use. Example:

 monit = command "monit" ["-c", "monitrc"]
 monit ["stop", "program"]

command_ :: FilePath -> [Text] -> [Text] -> Sh ()Source

bind some arguments to run_ for re-use. Example:

 monit_ = command_ "monit" ["-c", "monitrc"]
 monit_ ["stop", "program"]

command1 :: FilePath -> [Text] -> Text -> [Text] -> Sh TextSource

bind some arguments to run for re-use, and require 1 argument. Example:

 git = command1 "git" []; git "pull" ["origin", "master"]

command1_ :: FilePath -> [Text] -> Text -> [Text] -> Sh ()Source

bind some arguments to run for re-use, and require 1 argument. Example:

 git_ = command1_ "git" []; git "pull" ["origin", "master"]

sshPairs :: Text -> [(FilePath, [Text])] -> Sh TextSource

run commands over SSH. An ssh executable is expected in your path. Commands are in the same form as run, but given as pairs

 sshPairs "server-name" [("cd", "dir"), ("rm",["-r","dir2"])]

This interface is crude, but it works for now.

Please note this sets escaping to False: the commands will not be shell escaped. Internally the list of commands are combined with the string && before given to ssh.

sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh ()Source

same as sshPairs, but returns ()

class ShellArg a whereSource

Argument converter for the variadic argument version of run called cmd. Useful for a type signature of a function that uses cmd

Methods

toTextArg :: a -> TextSource

Running commands Using handles

runHandleSource

Arguments

:: FilePath

command

-> [Text]

arguments

-> (Handle -> Sh a)

stdout handle

-> Sh a 

Similar to run but gives the raw stdout handle in a callback. If you want even more control, use runHandles.

runHandlesSource

Arguments

:: FilePath

command

-> [Text]

arguments

-> [StdHandle]

optionally connect process i/o handles to existing handles

-> (Handle -> Handle -> Handle -> Sh a)

stdin, stdout and stderr

-> Sh a 

Similar to run but gives direct access to all input and output handles.

Be careful when using the optional input handles. If you specify Inherit for a handle then attempting to access the handle in your callback is an error

transferLinesAndCombine :: Handle -> Handle -> IO TextSource

Transfer from one handle to another For example, send contents of a process output to stdout. does not close the write handle.

Also, return the complete contents being streamed line by line.

transferFoldHandleLines :: a -> FoldCallback a -> Handle -> Handle -> IO aSource

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

data StdStream

Constructors

Inherit

Inherit Handle from parent

UseHandle Handle

Use the supplied Handle

CreatePipe

Create a new pipe. The returned Handle will use the default encoding and newline translation mode (just like Handles created by openFile).

Modifying and querying environment.

setenv :: Text -> Text -> Sh ()Source

Set an environment variable. The environment is maintained in Sh internally, and is passed to any external commands to be executed.

get_env :: Text -> Sh (Maybe Text)Source

Fetch the current value of an environment variable. if non-existant or empty text, will be Nothing

get_env_text :: Text -> Sh TextSource

Fetch the current value of an environment variable. Both empty and non-existent variables give empty string as a result.

getenv :: Text -> Sh TextSource

Deprecated: use get_env or get_env_text

deprecated

get_env_def :: Text -> Text -> Sh TextSource

Deprecated: use fromMaybe DEFAULT get_env

Fetch the current value of an environment variable. Both empty and non-existent variables give the default Text value as a result

appendToPath :: FilePath -> Sh ()Source

add the filepath onto the PATH env variable

Environment directory

cd :: FilePath -> Sh ()Source

Change current working directory of Sh. This does *not* change the working directory of the process we are running it. Instead, Sh keeps track of its own working directory and builds absolute paths internally instead of passing down relative paths.

chdir :: FilePath -> Sh a -> Sh aSource

cd, execute a Sh action in the new directory and then pop back to the original directory

pwd :: Sh FilePathSource

Obtain the current (Sh) working directory.

Printing

echo :: Text -> Sh ()Source

Echo text to standard (error, when using _err variants) output. The _n variants do not print a final newline.

echo_n :: Text -> Sh ()Source

Echo text to standard (error, when using _err variants) output. The _n variants do not print a final newline.

echo_err :: Text -> Sh ()Source

Echo text to standard (error, when using _err variants) output. The _n variants do not print a final newline.

echo_n_err :: Text -> Sh ()Source

Echo text to standard (error, when using _err variants) output. The _n variants do not print a final newline.

inspect :: Show s => s -> Sh ()Source

a print lifted into Sh

inspect_err :: Show s => s -> Sh ()Source

a print lifted into Sh using stderr

tag :: Sh a -> Text -> Sh aSource

same as trace, but use it combinator style

trace :: Text -> Sh ()Source

internally log what occurred. Log will be re-played on failure.

Querying filesystem.

ls :: FilePath -> Sh [FilePath]Source

List directory contents. Does *not* include "." and "..", but it does include (other) hidden files.

lsT :: FilePath -> Sh [Text]Source

Get back [Text] instead of [FilePath]

test_e :: FilePath -> Sh BoolSource

Does a path point to an existing filesystem object?

test_f :: FilePath -> Sh BoolSource

Does a path point to an existing file?

test_d :: FilePath -> Sh BoolSource

Does a path point to an existing directory?

test_s :: FilePath -> Sh BoolSource

Does a path point to a symlink?

which :: FilePath -> Sh (Maybe FilePath)Source

Get a full path to an executable by looking at the PATH environement variable. Windows normally looks in additional places besides the PATH: this does not duplicate that behavior.

Filename helpers

absPath :: FilePath -> Sh FilePathSource

Make a relative path absolute by combining with the working directory. An absolute path is returned as is. To create a relative path, use relPath.

(</>) :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> FilePathSource

uses System.FilePath.CurrentOS, but can automatically convert a Text

(<.>) :: ToFilePath filepath => filepath -> Text -> FilePathSource

uses System.FilePath.CurrentOS, but can automatically convert a Text

canonic :: FilePath -> Sh FilePathSource

makes an absolute path. Like canonicalize, but on an exception returns absPath

canonicalize :: FilePath -> Sh FilePathSource

Obtain a (reasonably) canonic file path to a filesystem object. Based on canonicalizePath in system-fileio.

relPath :: FilePath -> Sh FilePathSource

Makes a relative path relative to the current Sh working directory. An absolute path is returned as is. To create an absolute path, use absPath

relativeToSource

Arguments

:: FilePath

anchor path, the prefix

-> FilePath

make this relative to anchor path

-> Sh FilePath 

make the second path relative to the first Uses stripPrefix, but will canonicalize the paths if necessary

path :: FilePath -> Sh FilePathSource

Deprecated: use absPath, canonic, or relPath instead

deprecated

hasExt :: Text -> FilePath -> BoolSource

flipped hasExtension for Text

Manipulating filesystem.

mv :: FilePath -> FilePath -> Sh ()Source

Move a file. The second path could be a directory, in which case the original file is moved into that directory. wraps system-fileio rename, which may not work across FS boundaries

rm :: FilePath -> Sh ()Source

Remove a file. Does fail if the file does not exist (use rm_f instead) or is not a file.

rm_f :: FilePath -> Sh ()Source

Remove a file. Does not fail if the file does not exist. Does fail if the file is not a file.

rm_rf :: FilePath -> Sh ()Source

A swiss army cannon for removing things. Actually this goes farther than a normal rm -rf, as it will circumvent permission problems for the files we own. Use carefully. Uses removeTree

cp :: FilePath -> FilePath -> Sh ()Source

Copy a file. The second path could be a directory, in which case the original file name is used, in that directory.

cp_r :: FilePath -> FilePath -> Sh ()Source

Copy a file, or a directory recursively. uses cp

mkdir :: FilePath -> Sh ()Source

Create a new directory (fails if the directory exists).

mkdir_p :: FilePath -> Sh ()Source

Create a new directory, including parents (succeeds if the directory already exists).

mkdirTree :: Tree FilePath -> Sh ()Source

Create a new directory tree. You can describe a bunch of directories as a tree and this function will create all subdirectories. An example:

 exec = mkTree $
           "package" # [
                "src" # [
                    "Data" # leaves ["Tree", "List", "Set", "Map"] 
                ],
                "test" # leaves ["QuickCheck", "HUnit"],
                "dist/doc/html" # []
            ]
         where (#) = Node
               leaves = map (# []) 

reading/writing Files

readBinary :: FilePath -> Sh ByteStringSource

wraps ByteSting readFile

writefile :: FilePath -> Text -> Sh ()Source

Write a Lazy Text to a file.

appendfile :: FilePath -> Text -> Sh ()Source

Append a Lazy Text to a file.

touchfile :: FilePath -> Sh ()Source

Update a file, creating (a blank file) if it does not exist.

withTmpDir :: (FilePath -> Sh a) -> Sh aSource

Create a temporary directory and pass it as a parameter to a Sh computation. The directory is nuked afterwards.

exiting the program

exit :: Int -> Sh aSource

exit 0 means no errors, all other codes are error conditions

errorExit :: Text -> Sh aSource

echo a message and exit with status 1

quietExit :: Int -> Sh aSource

for exiting with status > 0 without printing debug information

terror :: Text -> Sh aSource

fail that takes a Text

Exceptions

catchany :: IO a -> (SomeException -> IO a) -> IO aSource

A helper to catch any exception (same as ... catch (e :: SomeException) -> ...).

catch_sh :: Exception e => Sh a -> (e -> Sh a) -> Sh aSource

Same as a normal catch but specialized for the Sh monad.

finally_sh :: Sh a -> Sh b -> Sh aSource

Same as a normal finally but specialized for the Sh monad.

data ShellyHandler a Source

You need to wrap exception handlers with this when using catches_sh.

Constructors

forall e . Exception e => ShellyHandler (e -> Sh a) 

catches_sh :: Sh a -> [ShellyHandler a] -> Sh aSource

Same as a normal catches, but specialized for the Sh monad.

catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh aSource

Catch an exception in the Sh monad.

convert between Text and FilePath

toTextIgnore :: FilePath -> TextSource

silently uses the Right or Left value of Filesystem.Path.CurrentOS.toText

Utility Functions

whenM :: Monad m => m Bool -> m () -> m ()Source

A monadic-conditional version of the when guard.

unlessM :: Monad m => m Bool -> m () -> m ()Source

A monadic-conditional version of the unless guard.

time :: Sh a -> Sh (Double, a)Source

Run a Sh computation and collect timing information.

sleep :: Int -> Sh ()Source

threadDelay wrapper that uses seconds

Re-exported for your convenience

liftIO :: MonadIO m => forall a. IO a -> m a

Lift a computation from the IO monad.

when :: Monad m => Bool -> m () -> m ()

Conditional execution of monadic expressions. For example,

       when debug (putStr "Debugging\n")

will output the string Debugging\n if the Boolean value debug is True, and otherwise do nothing.

unless :: Monad m => Bool -> m () -> m ()

The reverse of when.

(<$>) :: Functor f => (a -> b) -> f a -> f b

An infix synonym for fmap.

internal functions for writing extensions

get :: Sh StateSource

put :: State -> Sh ()Source

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.

findFold :: (a -> FilePath -> Sh a) -> a -> FilePath -> Sh aSource

Fold an arbitrary folding function over files froma a find. Like findWhen but use a more general fold rather than a filter.

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.

findDirFilterWhenSource

Arguments

:: (FilePath -> Sh Bool)

directory filter

-> (FilePath -> Sh Bool)

file filter

-> FilePath

directory

-> Sh [FilePath] 

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

like findDirFilterWhen but use a folding function rather than a filter The most general finder: you likely want a more specific one