{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

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

module Shelly
       (
         -- * Entering Sh
         Sh, ShIO, shelly, shellyNoDir, shellyFailDir, asyncSh, sub
         , silently, verbosely, escaping, print_stdout, print_stderr, print_commands
         , onCommandHandles
         , tracing, errExit
         , log_stdout_with, log_stderr_with

         -- * Running external commands
         , run, run_, runFoldLines, cmd, FoldCallback
         , bash, bash_, bashPipeFail
         , (-|-), lastStderr, setStdin, lastExitCode
         , command, command_, command1, command1_
         , sshPairs,sshPairsPar, sshPairs_,sshPairsPar_, sshPairsWithOptions
         , sshCommandText, SshMode(..)
         , ShellCmd(..), CmdArg (..)

         -- * Running commands Using handles
         , runHandle, runHandles, transferLinesAndCombine, transferFoldHandleLines
         , StdHandle(..), StdStream(..)

         -- * Handle manipulation
         , HandleInitializer, StdInit(..), initOutputHandles, initAllHandles

         -- * Modifying and querying environment
         , setenv, get_env, get_env_text, getenv, get_env_def, get_env_all, get_environment, appendToPath, prependToPath

         -- * Environment directory
         , cd, chdir, chdir_p, pwd

         -- * Printing
         , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err
         , tag, trace, show_command

         -- * Querying filesystem
         , ls, lsT, test_e, test_f, test_d, test_s, test_px, which

         -- * Filename helpers
         , absPath, (</>), (<.>), canonic, canonicalize, relPath, relativeTo, path
         , hasExt

         -- * Manipulating filesystem
         , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree

         -- * reading/writing Files
         , readfile, readBinary, writefile, writeBinary, appendfile, touchfile, withTmpDir

         -- * exiting the program
         , exit, errorExit, quietExit, terror

         -- * Exceptions
         , bracket_sh, catchany, catch_sh, handle_sh, handleany_sh, finally_sh, ShellyHandler(..), catches_sh, catchany_sh
         , ReThrownException(..)
         , RunFailed(..)

         -- * convert between Text and FilePath
         , toTextIgnore, toTextWarn, fromText

         -- * Utility Functions
         , whenM, unlessM, time, sleep

         -- * Re-exported for your convenience
         , liftIO, when, unless, FilePath, (<$>)

         -- * internal functions for writing extensions
         , get, put

         -- * find functions
         , find, findWhen, findFold, findDirFilter, findDirFilterWhen, findFoldDirFilter
         , followSymlink
         ) where

import Shelly.Base
import Shelly.Directory
import Shelly.Find

import Control.Applicative
import Control.Concurrent
import Control.Concurrent.Async (async, wait, Async)
import Control.Exception
import Control.Monad ( when, unless, void, liftM2 )
import Control.Monad.Trans ( MonadIO )
import Control.Monad.Reader (ask)

import Data.ByteString ( ByteString )
import Data.Char       ( isAlphaNum, isDigit, isSpace, isPrint )
#if defined(mingw32_HOST_OS)
import Data.Char       ( toLower )
#endif
import Data.Foldable   ( toList )
import Data.IORef
import Data.Maybe
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup  ( (<>) )
#endif
import Data.Sequence   ( Seq, (|>) )
import Data.Time.Clock ( getCurrentTime, diffUTCTime  )
import Data.Tree       ( Tree(..) )
import Data.Typeable

import qualified Data.ByteString as BS
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TE

import System.Directory
  ( setPermissions, getPermissions, Permissions(..), getTemporaryDirectory, pathIsSymbolicLink
  , copyFile, removeFile, doesFileExist, doesDirectoryExist
  , renameFile, renameDirectory, removeDirectoryRecursive, createDirectoryIfMissing
  , getCurrentDirectory
  )
import System.Environment
import System.Exit
import System.FilePath hiding ((</>), (<.>))
import qualified System.FilePath as FP
import System.IO ( Handle, hClose, stderr, stdout, openTempFile)
import System.IO.Error (isPermissionError, catchIOError, isEOFError, isIllegalOperation)
import System.Process
  ( CmdSpec(..), StdStream(CreatePipe, UseHandle), CreateProcess(..)
  , createProcess, waitForProcess, terminateProcess
  , ProcessHandle, StdStream(..)
  )

-- | Argument converter for the variadic argument version of 'run' called 'cmd'.
-- Useful for a type signature of a function that uses 'cmd'.
class CmdArg a where
  -- | @since 1.12.0
  toTextArgs :: a -> [Text]

instance CmdArg Text   where
  toTextArgs :: Text -> [Text]
toTextArgs = (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [])

instance CmdArg String where
  toTextArgs :: [Char] -> [Text]
toTextArgs = (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: []) (Text -> [Text]) -> ([Char] -> Text) -> [Char] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

instance {-# OVERLAPPABLE #-} CmdArg a => CmdArg [a] where
  toTextArgs :: [a] -> [Text]
toTextArgs = (a -> [Text]) -> [a] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [Text]
forall a. CmdArg a => a -> [Text]
toTextArgs

-- | For the variadic function 'cmd'.
--
-- Partially applied variadic functions require type signatures.
class ShellCmd t where
    cmdAll :: FilePath -> [Text] -> t

-- This is the only candidate for `_ <- cmd path x y z` so marking it incoherent will return it and
-- terminate the search immediately.  This also removes the warning for do { cmd path x y z ; .. }
-- as GHC will infer `Sh ()` instead of `Sh Text` as before.
instance {-# INCOHERENT #-} s ~ () => ShellCmd (Sh s) where
    cmdAll :: [Char] -> [Text] -> Sh s
cmdAll = [Char] -> [Text] -> Sh s
[Char] -> [Text] -> Sh ()
run_

instance ShellCmd (Sh Text) where
    cmdAll :: [Char] -> [Text] -> Sh Text
cmdAll = [Char] -> [Text] -> Sh Text
run

instance (CmdArg arg, ShellCmd result) => ShellCmd (arg -> result) where
    cmdAll :: [Char] -> [Text] -> arg -> result
cmdAll [Char]
fp [Text]
acc arg
x = [Char] -> [Text] -> result
forall t. ShellCmd t => [Char] -> [Text] -> t
cmdAll [Char]
fp ([Text]
acc [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ arg -> [Text]
forall a. CmdArg a => a -> [Text]
toTextArgs arg
x)

-- | 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)
--
cmd :: (ShellCmd result) => FilePath -> result
cmd :: forall result. ShellCmd result => [Char] -> result
cmd [Char]
fp = [Char] -> [Text] -> result
forall t. ShellCmd t => [Char] -> [Text] -> t
cmdAll [Char]
fp []

-- | Convert 'Text' to a 'FilePath'.
fromText :: Text -> FilePath
fromText :: Text -> [Char]
fromText = Text -> [Char]
T.unpack

-- | Helper to convert a Text to a FilePath. Used by '(</>)' and '(<.>)'
class ToFilePath a where
  toFilePath :: a -> FilePath

instance ToFilePath FilePath where toFilePath :: [Char] -> [Char]
toFilePath = [Char] -> [Char]
forall a. a -> a
id
instance ToFilePath Text     where toFilePath :: Text -> [Char]
toFilePath = Text -> [Char]
T.unpack


-- | Uses "System.FilePath", but can automatically convert a 'Text'.
(</>) :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> FilePath
filepath1
x </> :: forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</> filepath2
y = filepath1 -> [Char]
forall a. ToFilePath a => a -> [Char]
toFilePath filepath1
x [Char] -> [Char] -> [Char]
FP.</> filepath2 -> [Char]
forall a. ToFilePath a => a -> [Char]
toFilePath filepath2
y

-- | Uses "System.FilePath", but can automatically convert a 'Text'.
(<.>) :: (ToFilePath filepath) => filepath -> Text -> FilePath
filepath
x <.> :: forall filepath. ToFilePath filepath => filepath -> Text -> [Char]
<.> Text
y = filepath -> [Char]
forall a. ToFilePath a => a -> [Char]
toFilePath filepath
x [Char] -> [Char] -> [Char]
FP.<.> Text -> [Char]
T.unpack Text
y


toTextWarn :: FilePath -> Sh Text
toTextWarn :: [Char] -> Sh Text
toTextWarn [Char]
efile = do
  Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
isValid [Char]
efile) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text -> Sh ()
encodeError ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
makeValid [Char]
efile)
  Text -> Sh Text
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
makeValid [Char]
efile)
  where
    encodeError :: Text -> Sh ()
encodeError Text
f = Text -> Sh ()
echo (Text
"non-unicode file name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f)

-- | 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.
transferLinesAndCombine :: Handle -> (Text -> IO ()) -> IO Text
transferLinesAndCombine :: Handle -> (Text -> IO ()) -> IO Text
transferLinesAndCombine Handle
readHandle Text -> IO ()
putWrite =
  Seq Text
-> FoldCallback (Seq Text)
-> Handle
-> (Text -> IO ())
-> IO (Seq Text)
forall a. a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
transferFoldHandleLines Seq Text
forall a. Monoid a => a
mempty FoldCallback (Seq Text)
forall a. Seq a -> a -> Seq a
(|>) Handle
readHandle Text -> IO ()
putWrite IO (Seq Text) -> (Seq Text -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> (Seq Text -> Text) -> Seq Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> Text
lineSeqToText

lineSeqToText :: Seq Text -> Text
-- extra append puts a newline at the end
lineSeqToText :: Seq Text -> Text
lineSeqToText = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> (Seq Text -> [Text]) -> Seq Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Text -> [Text])
-> (Seq Text -> Seq Text) -> Seq Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldCallback (Seq Text) -> Text -> Seq Text -> Seq Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip FoldCallback (Seq Text)
forall a. Seq a -> a -> Seq a
(|>) Text
""

type FoldCallback a = (a -> Text -> a)

-- | 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.
transferFoldHandleLines :: a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
transferFoldHandleLines :: forall a. a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
transferFoldHandleLines a
start FoldCallback a
foldLine Handle
readHandle Text -> IO ()
putWrite = a -> IO a
go a
start
  where
    go :: a -> IO a
go a
acc = do
        Maybe Text
mLine <- IO Text -> IO (Maybe Text)
forall a. IO a -> IO (Maybe a)
filterIOErrors (IO Text -> IO (Maybe Text)) -> IO Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Handle -> IO Text
TIO.hGetLine Handle
readHandle
        case Maybe Text
mLine of
            Maybe Text
Nothing -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
acc
            Just Text
line -> Text -> IO ()
putWrite Text
line IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
go (FoldCallback a
foldLine a
acc Text
line)

filterIOErrors :: IO a -> IO (Maybe a)
filterIOErrors :: forall a. IO a -> IO (Maybe a)
filterIOErrors IO a
action = IO (Maybe a) -> (IOError -> IO (Maybe a)) -> IO (Maybe a)
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError
               ((a -> Maybe a) -> IO a -> IO (Maybe a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just IO a
action)
               (\IOError
e -> if IOError -> Bool
isEOFError IOError
e Bool -> Bool -> Bool
|| IOError -> Bool
isIllegalOperation IOError
e -- handle was closed
                       then Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                       else IOError -> IO (Maybe a)
forall a. IOError -> IO a
ioError IOError
e)

foldHandleLines :: a -> FoldCallback a -> Handle -> IO a
foldHandleLines :: forall a. a -> FoldCallback a -> Handle -> IO a
foldHandleLines a
start FoldCallback a
foldLine Handle
readHandle = a -> IO a
go a
start
  where
    go :: a -> IO a
go a
acc = do
      Maybe Text
mLine <- IO Text -> IO (Maybe Text)
forall a. IO a -> IO (Maybe a)
filterIOErrors (IO Text -> IO (Maybe Text)) -> IO Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Handle -> IO Text
TIO.hGetLine Handle
readHandle
      case Maybe Text
mLine of
        Maybe Text
Nothing -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
acc
        Just Text
line -> a -> IO a
go (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ FoldCallback a
foldLine a
acc Text
line

-- | Same as 'trace', but for use in combinator style: @action `tag` message@.
tag :: Sh a -> Text -> Sh a
tag :: forall a. Sh a -> Text -> Sh a
tag Sh a
action Text
msg = do
  Text -> Sh ()
trace Text
msg
  Sh a
action

put :: State -> Sh ()
put :: State -> Sh ()
put State
newState = do
  IORef State
stateVar <- Sh (IORef State)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef State -> State -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef State
stateVar State
newState)

runCommandNoEscape :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle)
runCommandNoEscape :: [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommandNoEscape [StdHandle]
handles State
st [Char]
exe [Text]
args = IO (Handle, Handle, Handle, ProcessHandle)
-> Sh (Handle, Handle, Handle, ProcessHandle)
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Handle, Handle, Handle, ProcessHandle)
 -> Sh (Handle, Handle, Handle, ProcessHandle))
-> IO (Handle, Handle, Handle, ProcessHandle)
-> Sh (Handle, Handle, Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ [StdHandle]
-> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
shellyProcess [StdHandle]
handles State
st (CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle))
-> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$
    [Char] -> CmdSpec
ShellCommand ([Char] -> CmdSpec) -> [Char] -> CmdSpec
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
" " ([Char] -> Text
toTextIgnore [Char]
exe Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)

runCommand :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand :: [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand [StdHandle]
handles State
st [Char]
exe [Text]
args = [Char] -> Sh [Char]
findExe [Char]
exe Sh [Char]
-> ([Char] -> Sh (Handle, Handle, Handle, ProcessHandle))
-> Sh (Handle, Handle, Handle, ProcessHandle)
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
fullExe ->
  IO (Handle, Handle, Handle, ProcessHandle)
-> Sh (Handle, Handle, Handle, ProcessHandle)
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Handle, Handle, Handle, ProcessHandle)
 -> Sh (Handle, Handle, Handle, ProcessHandle))
-> IO (Handle, Handle, Handle, ProcessHandle)
-> Sh (Handle, Handle, Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ [StdHandle]
-> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
shellyProcess [StdHandle]
handles State
st (CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle))
-> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$
    [Char] -> [[Char]] -> CmdSpec
RawCommand [Char]
fullExe ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack [Text]
args)
  where
    findExe :: FilePath -> Sh FilePath
    findExe :: [Char] -> Sh [Char]
findExe
#if defined(mingw32_HOST_OS)
      fp
#else
      [Char]
_fp
#endif
      = do
        Either [Char] [Char]
mExe <- [Char] -> Sh (Either [Char] [Char])
whichEith [Char]
exe
        case Either [Char] [Char]
mExe of
          Right [Char]
execFp -> [Char] -> Sh [Char]
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
execFp
          -- windows looks in extra places besides the PATH, so just give
          -- up even if the behavior is not properly specified anymore
          --
          -- non-Windows < 7.8 has a bug for read-only file systems
          -- https://github.com/yesodweb/Shelly.hs/issues/56
          -- it would be better to specifically detect that bug
#if defined(mingw32_HOST_OS)
          Left _ -> return fp
#else
          Left [Char]
err -> IO [Char] -> Sh [Char]
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> Sh [Char]) -> IO [Char] -> Sh [Char]
forall a b. (a -> b) -> a -> b
$ IOError -> IO [Char]
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO [Char]) -> IOError -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError [Char]
err
#endif


-- process >= 1.4 is used

shellyProcess :: [StdHandle] -> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
shellyProcess :: [StdHandle]
-> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
shellyProcess [StdHandle]
reusedHandles State
st CmdSpec
cmdSpec =  do
    (Maybe Handle
createdInH, Maybe Handle
createdOutH, Maybe Handle
createdErrorH, ProcessHandle
pHandle) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess {
          cmdspec :: CmdSpec
cmdspec = CmdSpec
cmdSpec
        , cwd :: Maybe [Char]
cwd = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ State -> [Char]
sDirectory State
st
        , env :: Maybe [([Char], [Char])]
env = [([Char], [Char])] -> Maybe [([Char], [Char])]
forall a. a -> Maybe a
Just ([([Char], [Char])] -> Maybe [([Char], [Char])])
-> [([Char], [Char])] -> Maybe [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ State -> [([Char], [Char])]
sEnvironment State
st
        , std_in :: StdStream
std_in  = Maybe StdStream -> StdStream
createUnless Maybe StdStream
mInH
        , std_out :: StdStream
std_out = Maybe StdStream -> StdStream
createUnless Maybe StdStream
mOutH
        , std_err :: StdStream
std_err = Maybe StdStream -> StdStream
createUnless Maybe StdStream
mErrorH
        , close_fds :: Bool
close_fds = Bool
False
        , create_group :: Bool
create_group = Bool
False
        , delegate_ctlc :: Bool
delegate_ctlc = Bool
False
        , detach_console :: Bool
detach_console = Bool
False
        , create_new_console :: Bool
create_new_console = Bool
False
        , new_session :: Bool
new_session = Bool
False
        , child_group :: Maybe GroupID
child_group = Maybe GroupID
forall a. Maybe a
Nothing
        , child_user :: Maybe UserID
child_user = Maybe UserID
forall a. Maybe a
Nothing
#if MIN_VERSION_process(1,5,0)
        , use_process_jobs :: Bool
use_process_jobs = Bool
False
#endif
        }
    (Handle, Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, Handle, ProcessHandle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe Handle -> Handle
forall a. Maybe a -> a
just (Maybe Handle -> Handle) -> Maybe Handle -> Handle
forall a b. (a -> b) -> a -> b
$ Maybe Handle
createdInH Maybe Handle -> Maybe Handle -> Maybe Handle
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StdStream -> Maybe Handle
toHandle Maybe StdStream
mInH
           , Maybe Handle -> Handle
forall a. Maybe a -> a
just (Maybe Handle -> Handle) -> Maybe Handle -> Handle
forall a b. (a -> b) -> a -> b
$ Maybe Handle
createdOutH Maybe Handle -> Maybe Handle -> Maybe Handle
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StdStream -> Maybe Handle
toHandle Maybe StdStream
mOutH
           , Maybe Handle -> Handle
forall a. Maybe a -> a
just (Maybe Handle -> Handle) -> Maybe Handle -> Handle
forall a b. (a -> b) -> a -> b
$ Maybe Handle
createdErrorH Maybe Handle -> Maybe Handle -> Maybe Handle
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StdStream -> Maybe Handle
toHandle Maybe StdStream
mErrorH
           , ProcessHandle
pHandle
           )
  where
    just :: Maybe a -> a
    just :: forall a. Maybe a -> a
just Maybe a
Nothing  = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"error in shelly creating process"
    just (Just a
j) = a
j

    toHandle :: Maybe StdStream -> Maybe Handle
toHandle (Just (UseHandle Handle
h)) = Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h
    toHandle (Just StdStream
CreatePipe)    = [Char] -> Maybe Handle
forall a. HasCallStack => [Char] -> a
error [Char]
"shelly process creation failure CreatePipe"
    toHandle (Just StdStream
Inherit)       = [Char] -> Maybe Handle
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot access an inherited pipe"
    toHandle (Just StdStream
NoStream)      = [Char] -> Maybe Handle
forall a. HasCallStack => [Char] -> a
error [Char]
"shelly process creation failure NoStream"
    toHandle Maybe StdStream
Nothing              = [Char] -> Maybe Handle
forall a. HasCallStack => [Char] -> a
error [Char]
"error in shelly creating process"

    createUnless :: Maybe StdStream -> StdStream
createUnless Maybe StdStream
Nothing = StdStream
CreatePipe
    createUnless (Just StdStream
stream) = StdStream
stream

    mInH :: Maybe StdStream
mInH    = (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream StdHandle -> Maybe StdStream
mIn [StdHandle]
reusedHandles
    mOutH :: Maybe StdStream
mOutH   = (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream StdHandle -> Maybe StdStream
mOut [StdHandle]
reusedHandles
    mErrorH :: Maybe StdStream
mErrorH = (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream StdHandle -> Maybe StdStream
mError [StdHandle]
reusedHandles

    getStream :: (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
    getStream :: (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream StdHandle -> Maybe StdStream
_ [] = Maybe StdStream
forall a. Maybe a
Nothing
    getStream StdHandle -> Maybe StdStream
mHandle (StdHandle
h:[StdHandle]
hs) = StdHandle -> Maybe StdStream
mHandle StdHandle
h Maybe StdStream -> Maybe StdStream -> Maybe StdStream
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream StdHandle -> Maybe StdStream
mHandle [StdHandle]
hs

    mIn, mOut, mError :: (StdHandle -> Maybe StdStream)
    mIn :: StdHandle -> Maybe StdStream
mIn (InHandle StdStream
h) = StdStream -> Maybe StdStream
forall a. a -> Maybe a
Just StdStream
h
    mIn StdHandle
_ = Maybe StdStream
forall a. Maybe a
Nothing
    mOut :: StdHandle -> Maybe StdStream
mOut (OutHandle StdStream
h) = StdStream -> Maybe StdStream
forall a. a -> Maybe a
Just StdStream
h
    mOut StdHandle
_ = Maybe StdStream
forall a. Maybe a
Nothing
    mError :: StdHandle -> Maybe StdStream
mError (ErrorHandle StdStream
h) = StdStream -> Maybe StdStream
forall a. a -> Maybe a
Just StdStream
h
    mError StdHandle
_ = Maybe StdStream
forall a. Maybe a
Nothing

{-
-- | use for commands requiring usage of sudo. see 'run_sudo'.
--  Use this pattern for priveledge separation
newtype Sudo a = Sudo { sudo :: Sh a }

-- | require that the caller explicitly state 'sudo'
run_sudo :: Text -> [Text] -> Sudo Text
run_sudo cmd args = Sudo $ run "/usr/bin/sudo" (cmd:args)
-}

-- | Same as a normal 'catch' but specialized for the Sh monad.
catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a
catch_sh :: forall e a. Exception e => Sh a -> (e -> Sh a) -> Sh a
catch_sh Sh a
action e -> Sh a
handler = do
    IORef State
ref <- Sh (IORef State)
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Sh a -> IORef State -> IO a
forall a. Sh a -> IORef State -> IO a
runSh Sh a
action IORef State
ref) (\e
e -> Sh a -> IORef State -> IO a
forall a. Sh a -> IORef State -> IO a
runSh (e -> Sh a
handler e
e) IORef State
ref)

-- | Same as a normal 'handle' but specialized for the Sh monad.
handle_sh :: (Exception e) => (e -> Sh a) -> Sh a -> Sh a
handle_sh :: forall e a. Exception e => (e -> Sh a) -> Sh a -> Sh a
handle_sh e -> Sh a
handler Sh a
action = do
    IORef State
ref <- Sh (IORef State)
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ (e -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\e
e -> Sh a -> IORef State -> IO a
forall a. Sh a -> IORef State -> IO a
runSh (e -> Sh a
handler e
e) IORef State
ref) (Sh a -> IORef State -> IO a
forall a. Sh a -> IORef State -> IO a
runSh Sh a
action IORef State
ref)


-- | Same as a normal 'finally' but specialized for the 'Sh' monad.
finally_sh :: Sh a -> Sh b -> Sh a
finally_sh :: forall a b. Sh a -> Sh b -> Sh a
finally_sh Sh a
action Sh b
handler = do
    IORef State
ref <- Sh (IORef State)
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
finally (Sh a -> IORef State -> IO a
forall a. Sh a -> IORef State -> IO a
runSh Sh a
action IORef State
ref) (Sh b -> IORef State -> IO b
forall a. Sh a -> IORef State -> IO a
runSh Sh b
handler IORef State
ref)

bracket_sh :: Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
bracket_sh :: forall a b c. Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
bracket_sh Sh a
acquire a -> Sh b
release a -> Sh c
main = do
  IORef State
ref <- Sh (IORef State)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO c -> Sh c
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO c -> Sh c) -> IO c -> Sh c
forall a b. (a -> b) -> a -> b
$ IO a -> (a -> IO b) -> (a -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Sh a -> IORef State -> IO a
forall a. Sh a -> IORef State -> IO a
runSh Sh a
acquire IORef State
ref)
                   (\a
resource -> Sh b -> IORef State -> IO b
forall a. Sh a -> IORef State -> IO a
runSh (a -> Sh b
release a
resource) IORef State
ref)
                   (\a
resource -> Sh c -> IORef State -> IO c
forall a. Sh a -> IORef State -> IO a
runSh (a -> Sh c
main a
resource) IORef State
ref)



-- | You need to wrap exception handlers with this when using 'catches_sh'.
data ShellyHandler a = forall e . Exception e => ShellyHandler (e -> Sh a)

-- | Same as a normal 'catches', but specialized for the 'Sh' monad.
catches_sh :: Sh a -> [ShellyHandler a] -> Sh a
catches_sh :: forall a. Sh a -> [ShellyHandler a] -> Sh a
catches_sh Sh a
action [ShellyHandler a]
handlers = do
    IORef State
ref <- Sh (IORef State)
forall r (m :: * -> *). MonadReader r m => m r
ask
    let runner :: Sh a -> IO a
runner Sh a
a = Sh a -> IORef State -> IO a
forall a. Sh a -> IORef State -> IO a
runSh Sh a
a IORef State
ref
    IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
catches (Sh a -> IO a
runner Sh a
action) ([Handler a] -> IO a) -> [Handler a] -> IO a
forall a b. (a -> b) -> a -> b
$ (ShellyHandler a -> Handler a) -> [ShellyHandler a] -> [Handler a]
forall a b. (a -> b) -> [a] -> [b]
map ((Sh a -> IO a) -> ShellyHandler a -> Handler a
forall a. (Sh a -> IO a) -> ShellyHandler a -> Handler a
toHandler Sh a -> IO a
runner) [ShellyHandler a]
handlers
  where
    toHandler :: (Sh a -> IO a) -> ShellyHandler a -> Handler a
    toHandler :: forall a. (Sh a -> IO a) -> ShellyHandler a -> Handler a
toHandler Sh a -> IO a
runner (ShellyHandler e -> Sh a
handler) = (e -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\e
e -> Sh a -> IO a
runner (e -> Sh a
handler e
e))

-- | Catch any exception in the 'Sh' monad.
catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a
catchany_sh :: forall a. Sh a -> (SomeException -> Sh a) -> Sh a
catchany_sh = Sh a -> (SomeException -> Sh a) -> Sh a
forall e a. Exception e => Sh a -> (e -> Sh a) -> Sh a
catch_sh

-- | Handle any exception in the 'Sh' monad.
handleany_sh :: (SomeException -> Sh a) -> Sh a -> Sh a
handleany_sh :: forall a. (SomeException -> Sh a) -> Sh a -> Sh a
handleany_sh = (SomeException -> Sh a) -> Sh a -> Sh a
forall e a. Exception e => (e -> Sh a) -> Sh a -> Sh a
handle_sh

-- | 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.
cd :: FilePath -> Sh ()
cd :: [Char] -> Sh ()
cd = (Text -> Text) -> [Char] -> Sh [Char]
traceCanonicPath (Text
"cd " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Sh [Char]) -> ([Char] -> Sh ()) -> [Char] -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Char] -> Sh ()
cd'
  where
    cd' :: [Char] -> Sh ()
cd' [Char]
dir = do
        Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM ([Char] -> Sh Bool
test_d [Char]
dir) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text -> Sh ()
forall a. Text -> Sh a
errorExit (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text
"not a directory: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tdir
        (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sDirectory :: [Char]
sDirectory = [Char]
dir, sPathExecutables :: Maybe [([Char], Set [Char])]
sPathExecutables = Maybe [([Char], Set [Char])]
forall a. Maybe a
Nothing }
      where
        tdir :: Text
tdir = [Char] -> Text
toTextIgnore [Char]
dir

-- | 'cd', execute a 'Sh' action in the new directory
-- and then pop back to the original directory.
chdir :: FilePath -> Sh a -> Sh a
chdir :: forall a. [Char] -> Sh a -> Sh a
chdir [Char]
dir Sh a
action = do
  [Char]
d <- (State -> [Char]) -> Sh [Char]
forall a. (State -> a) -> Sh a
gets State -> [Char]
sDirectory
  [Char] -> Sh ()
cd [Char]
dir
  Sh a
action Sh a -> Sh () -> Sh a
forall a b. Sh a -> Sh b -> Sh a
`finally_sh` [Char] -> Sh ()
cd [Char]
d

-- | 'chdir', but first create the directory if it does not exit.
chdir_p :: FilePath -> Sh a -> Sh a
chdir_p :: forall a. [Char] -> Sh a -> Sh a
chdir_p [Char]
d Sh a
action = [Char] -> Sh ()
mkdir_p [Char]
d Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Sh a -> Sh a
forall a. [Char] -> Sh a -> Sh a
chdir [Char]
d Sh a
action


pack :: String -> FilePath
pack :: [Char] -> [Char]
pack = [Char] -> [Char]
forall a. a -> a
id

-- | Move a file. The second path could be a directory, in which case the
-- original file is moved into that directory.
-- wraps directory 'System.Directory.renameFile', which may not work across FS boundaries
mv :: FilePath -> FilePath -> Sh ()
mv :: [Char] -> [Char] -> Sh ()
mv [Char]
from' [Char]
to' = do
  Text -> Sh ()
trace (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text
"mv " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
from' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
to'
  [Char]
from <- [Char] -> Sh [Char]
absPath [Char]
from'
  Bool
from_dir <- [Char] -> Sh Bool
test_d [Char]
from
  [Char]
to <- [Char] -> Sh [Char]
absPath [Char]
to'
  Bool
to_dir <- [Char] -> Sh Bool
test_d [Char]
to
  let to_loc :: [Char]
to_loc = if Bool -> Bool
not Bool
to_dir then [Char]
to else [Char]
to [Char] -> [Char] -> [Char]
FP.</> ([Char] -> [Char]
FP.takeFileName [Char]
from)
  IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True ([Char] -> [Char]
takeDirectory [Char]
to_loc)
  if Bool -> Bool
not Bool
from_dir
    then IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
renameFile [Char]
from [Char]
to_loc
      IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (\SomeException
e -> ReThrownException SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ReThrownException SomeException -> IO ())
-> ReThrownException SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$
        SomeException -> [Char] -> ReThrownException SomeException
forall e. e -> [Char] -> ReThrownException e
ReThrownException SomeException
e ([Char] -> [Char] -> [Char]
extraMsg [Char]
to_loc [Char]
from)
      )
    else IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
renameDirectory [Char]
from [Char]
to_loc
      IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (\SomeException
e -> ReThrownException SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ReThrownException SomeException -> IO ())
-> ReThrownException SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$
        SomeException -> [Char] -> ReThrownException SomeException
forall e. e -> [Char] -> ReThrownException e
ReThrownException SomeException
e ([Char] -> [Char] -> [Char]
extraMsg [Char]
to_loc [Char]
from)
      )
  where
    extraMsg :: String -> String -> String
    extraMsg :: [Char] -> [Char] -> [Char]
extraMsg [Char]
t [Char]
f = [Char]
"during copy from: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" to: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t

-- | Get back @[Text]@ instead of @[FilePath]@.
lsT :: FilePath -> Sh [Text]
lsT :: [Char] -> Sh [Text]
lsT = [Char] -> Sh [[Char]]
ls ([Char] -> Sh [[Char]])
-> ([[Char]] -> Sh [Text]) -> [Char] -> Sh [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ([Char] -> Sh Text) -> [[Char]] -> Sh [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Sh Text
toTextWarn

-- | Obtain the current 'Sh' working directory.
pwd :: Sh FilePath
pwd :: Sh [Char]
pwd = (State -> [Char]) -> Sh [Char]
forall a. (State -> a) -> Sh a
gets State -> [Char]
sDirectory Sh [Char] -> Text -> Sh [Char]
forall a. Sh a -> Text -> Sh a
`tag` Text
"pwd"

-- | @'exit' 0@ means no errors, all other codes are error conditions.
exit :: Int -> Sh a
exit :: forall a. Int -> Sh a
exit Int
0 = IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
forall a. IO a
exitSuccess Sh a -> Text -> Sh a
forall a. Sh a -> Text -> Sh a
`tag` Text
"exit 0"
exit Int
n = IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
n)) Sh a -> Text -> Sh a
forall a. Sh a -> Text -> Sh a
`tag` (Text
"exit " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n))

-- | Echo a message and 'exit' with status 1.
errorExit :: Text -> Sh a
errorExit :: forall a. Text -> Sh a
errorExit Text
msg = Text -> Sh ()
echo Text
msg Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Sh a
forall a. Int -> Sh a
exit Int
1

-- | For exiting with status > 0 without printing debug information.
quietExit :: Int -> Sh a
quietExit :: forall a. Int -> Sh a
quietExit Int
0 = Int -> Sh a
forall a. Int -> Sh a
exit Int
0
quietExit Int
n = QuietExit -> Sh a
forall a e. Exception e => e -> a
throw (QuietExit -> Sh a) -> QuietExit -> Sh a
forall a b. (a -> b) -> a -> b
$ Int -> QuietExit
QuietExit Int
n

-- | 'fail' that takes a 'Text'.
terror :: Text -> Sh a
terror :: forall a. Text -> Sh a
terror = [Char] -> Sh a
forall a. [Char] -> Sh a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Sh a) -> (Text -> [Char]) -> Text -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

-- | Create a new directory (fails if the directory exists).
mkdir :: FilePath -> Sh ()
mkdir :: [Char] -> Sh ()
mkdir = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"mkdir " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Sh [Char]) -> ([Char] -> Sh ()) -> [Char] -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> ([Char] -> IO ()) -> [Char] -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False

-- | Create a new directory, including parents (succeeds if the directory
-- already exists).
mkdir_p :: FilePath -> Sh ()
mkdir_p :: [Char] -> Sh ()
mkdir_p = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"mkdir -p " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Sh [Char]) -> ([Char] -> Sh ()) -> [Char] -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
          IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> ([Char] -> IO ()) -> [Char] -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True

-- | 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 (# [])
--
mkdirTree :: Tree FilePath -> Sh ()
mkdirTree :: Tree [Char] -> Sh ()
mkdirTree = Tree [Char] -> Sh ()
mk (Tree [Char] -> Sh ())
-> (Tree [Char] -> Tree [Char]) -> Tree [Char] -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree [Char] -> Tree [Char]
unrollPath
    where mk :: Tree FilePath -> Sh ()
          mk :: Tree [Char] -> Sh ()
mk (Node [Char]
a [Tree [Char]]
ts) = do
            Bool
b <- [Char] -> Sh Bool
test_d [Char]
a
            Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Sh ()
mkdir [Char]
a
            [Char] -> Sh () -> Sh ()
forall a. [Char] -> Sh a -> Sh a
chdir [Char]
a (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ (Tree [Char] -> Sh ()) -> [Tree [Char]] -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Tree [Char] -> Sh ()
mkdirTree [Tree [Char]]
ts

          unrollPath :: Tree FilePath -> Tree FilePath
          unrollPath :: Tree [Char] -> Tree [Char]
unrollPath (Node [Char]
v [Tree [Char]]
ts) = [Char] -> [Tree [Char]] -> Tree [Char]
unrollRoot [Char]
v ([Tree [Char]] -> Tree [Char]) -> [Tree [Char]] -> Tree [Char]
forall a b. (a -> b) -> a -> b
$ (Tree [Char] -> Tree [Char]) -> [Tree [Char]] -> [Tree [Char]]
forall a b. (a -> b) -> [a] -> [b]
map Tree [Char] -> Tree [Char]
unrollPath [Tree [Char]]
ts
              where unrollRoot :: [Char] -> [Tree [Char]] -> Tree [Char]
unrollRoot [Char]
x = (([Tree [Char]] -> Tree [Char])
 -> ([Tree [Char]] -> Tree [Char]) -> [Tree [Char]] -> Tree [Char])
-> [[Tree [Char]] -> Tree [Char]] -> [Tree [Char]] -> Tree [Char]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ([Tree [Char]] -> Tree [Char])
-> ([Tree [Char]] -> Tree [Char]) -> [Tree [Char]] -> Tree [Char]
forall {m :: * -> *} {b} {c} {a}.
Monad m =>
(m b -> c) -> (a -> b) -> a -> c
phi ([[Tree [Char]] -> Tree [Char]] -> [Tree [Char]] -> Tree [Char])
-> [[Tree [Char]] -> Tree [Char]] -> [Tree [Char]] -> Tree [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Tree [Char]] -> Tree [Char])
-> [[Char]] -> [[Tree [Char]] -> Tree [Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Tree [Char]] -> Tree [Char]
forall a. a -> [Tree a] -> Tree a
Node ([[Char]] -> [[Tree [Char]] -> Tree [Char]])
-> [[Char]] -> [[Tree [Char]] -> Tree [Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
splitDirectories [Char]
x
                    phi :: (m b -> c) -> (a -> b) -> a -> c
phi m b -> c
a a -> b
b = m b -> c
a (m b -> c) -> (a -> m b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
b


isExecutable :: FilePath -> IO Bool
isExecutable :: [Char] -> IO Bool
isExecutable [Char]
f = (Permissions -> Bool
executable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO Permissions
getPermissions [Char]
f) IO Bool -> (IOError -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOError
_ :: IOError) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | 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.
which :: FilePath -> Sh (Maybe FilePath)
which :: [Char] -> Sh (Maybe [Char])
which [Char]
fp = ([Char] -> Maybe [Char])
-> ([Char] -> Maybe [Char]) -> Either [Char] [Char] -> Maybe [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe [Char] -> [Char] -> Maybe [Char]
forall a b. a -> b -> a
const Maybe [Char]
forall a. Maybe a
Nothing) [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Either [Char] [Char] -> Maybe [Char])
-> Sh (Either [Char] [Char]) -> Sh (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Sh (Either [Char] [Char])
whichEith [Char]
fp

-- | 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.
whichEith :: FilePath -> Sh (Either String FilePath)
whichEith :: [Char] -> Sh (Either [Char] [Char])
whichEith [Char]
originalFp = [Char] -> Sh (Either [Char] [Char])
whichFull
#if defined(mingw32_HOST_OS)
    $ case takeExtension originalFp of
        "" -> originalFp <.> "exe"
        _ -> originalFp
#else
    [Char]
originalFp
#endif
  where
    whichFull :: [Char] -> Sh (Either [Char] [Char])
whichFull [Char]
fp = do
      (Text -> Sh ()
trace (Text -> Sh ()) -> ([Char] -> Text) -> [Char] -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"which " (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
toTextIgnore) [Char]
fp Sh () -> Sh (Either [Char] [Char]) -> Sh (Either [Char] [Char])
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh (Either [Char] [Char])
whichUntraced
      where
        whichUntraced :: Sh (Either [Char] [Char])
whichUntraced | [Char] -> Bool
isAbsolute [Char]
fp             = Sh (Either [Char] [Char])
checkFile
                      | [[Char]] -> Bool
forall {a}. (Eq a, IsString a) => [a] -> Bool
startsWithDot [[Char]]
splitOnDirs = Sh (Either [Char] [Char])
checkFile
                      | Bool
otherwise                 = Sh (Maybe [Char])
lookupPath  Sh (Maybe [Char])
-> (Maybe [Char] -> Sh (Either [Char] [Char]))
-> Sh (Either [Char] [Char])
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe [Char] -> Sh (Either [Char] [Char])
leftPathError

        splitOnDirs :: [[Char]]
splitOnDirs = [Char] -> [[Char]]
splitDirectories [Char]
fp

        -- 'startsWithDot' receives as input the result of 'splitDirectories',
        -- which will include the dot (\".\") as its first element only if this
        -- is a path of the form \"./foo/bar/baz.sh\". Check for example:
        --
        -- > import System.FilePath as FP
        -- > FP.splitDirectories "./test/data/hello.sh"
        -- [".","test","data","hello.sh"]
        -- > FP.splitDirectories ".hello.sh"
        -- [".hello.sh"]
        -- > FP.splitDirectories ".test/hello.sh"
        -- [".test","hello.sh"]
        -- > FP.splitDirectories ".foo"
        -- [".foo"]
        --
        -- Note that earlier versions of Shelly used
        -- \"system-filepath\" which also has a 'splitDirectories'
        -- function, but it returns \"./\" as its first argument,
        -- so we pattern match on both for backward-compatibility.
        startsWithDot :: [a] -> Bool
startsWithDot (a
".":[a]
_)  = Bool
True
        startsWithDot [a]
_ = Bool
False

        checkFile :: Sh (Either String FilePath)
        checkFile :: Sh (Either [Char] [Char])
checkFile = do
            Bool
exists <- IO Bool -> Sh Bool
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Sh Bool) -> IO Bool -> Sh Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
fp
            Either [Char] [Char] -> Sh (Either [Char] [Char])
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] [Char] -> Sh (Either [Char] [Char]))
-> Either [Char] [Char] -> Sh (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ if Bool
exists then [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right [Char]
fp else
              [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"did not find file: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
fp

        leftPathError :: Maybe FilePath -> Sh (Either String FilePath)
        leftPathError :: Maybe [Char] -> Sh (Either [Char] [Char])
leftPathError Maybe [Char]
Nothing  = [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left ([Char] -> Either [Char] [Char])
-> Sh [Char] -> Sh (Either [Char] [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh [Char]
pathLookupError
        leftPathError (Just [Char]
x) = Either [Char] [Char] -> Sh (Either [Char] [Char])
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] [Char] -> Sh (Either [Char] [Char]))
-> Either [Char] [Char] -> Sh (Either [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right [Char]
x

        pathLookupError :: Sh String
        pathLookupError :: Sh [Char]
pathLookupError = do
          Text
pATH <- Text -> Sh Text
get_env_text Text
"PATH"
          [Char] -> Sh [Char]
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Sh [Char]) -> [Char] -> Sh [Char]
forall a b. (a -> b) -> a -> b
$
            [Char]
"shelly did not find " [Char] -> [Char] -> [Char]
forall a. Monoid a => a -> a -> a
`mappend` [Char]
fp [Char] -> [Char] -> [Char]
forall a. Monoid a => a -> a -> a
`mappend`
            [Char]
" in the PATH: " [Char] -> [Char] -> [Char]
forall a. Monoid a => a -> a -> a
`mappend` Text -> [Char]
T.unpack Text
pATH

        lookupPath :: Sh (Maybe FilePath)
        lookupPath :: Sh (Maybe [Char])
lookupPath = (Sh [[Char]]
pathDirs Sh [[Char]] -> ([[Char]] -> Sh (Maybe [Char])) -> Sh (Maybe [Char])
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) (([[Char]] -> Sh (Maybe [Char])) -> Sh (Maybe [Char]))
-> ([[Char]] -> Sh (Maybe [Char])) -> Sh (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ ([Char] -> Sh (Maybe [Char])) -> [[Char]] -> Sh (Maybe [Char])
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM (([Char] -> Sh (Maybe [Char])) -> [[Char]] -> Sh (Maybe [Char]))
-> ([Char] -> Sh (Maybe [Char])) -> [[Char]] -> Sh (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \[Char]
dir -> do
            let fullFp :: [Char]
fullFp = [Char]
dir [Char] -> [Char] -> [Char]
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</> [Char]
fp
            Bool
res <- IO Bool -> Sh Bool
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Sh Bool) -> IO Bool -> Sh Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
isExecutable [Char]
fullFp
            Maybe [Char] -> Sh (Maybe [Char])
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> Sh (Maybe [Char]))
-> Maybe [Char] -> Sh (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ if Bool
res then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fullFp else Maybe [Char]
forall a. Maybe a
Nothing

        pathDirs :: Sh [[Char]]
pathDirs = ([Char] -> Sh [Char]) -> [[Char]] -> Sh [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> Sh [Char]
absPath ([[Char]] -> Sh [[Char]]) -> Sh [[Char]] -> Sh [[Char]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack ([Text] -> [[Char]]) -> (Text -> [Text]) -> Text -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
searchPathSeparator)) (Text -> [[Char]]) -> Sh Text -> Sh [[Char]]
forall a b. (a -> b) -> Sh a -> Sh b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> Sh Text
get_env_text Text
"PATH")

-- | A monadic findMap, taken from MissingM package
findMapM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM a -> m (Maybe b)
_ [] = Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
findMapM a -> m (Maybe b)
f (a
x:[a]
xs) = do
    Maybe b
mb <- a -> m (Maybe b)
f a
x
    if (Maybe b -> Bool
forall a. Maybe a -> Bool
isJust Maybe b
mb)
      then Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
mb
      else (a -> m (Maybe b)) -> [a] -> m (Maybe b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM a -> m (Maybe b)
f [a]
xs

-- | A monadic-conditional version of the 'unless' guard.
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM m Bool
c m ()
a = m Bool
c m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
res -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
res m ()
a

-- | Does a path point to an existing filesystem object?
test_e :: FilePath -> Sh Bool
test_e :: [Char] -> Sh Bool
test_e = [Char] -> Sh [Char]
absPath ([Char] -> Sh [Char]) -> ([Char] -> Sh Bool) -> [Char] -> Sh Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
f ->
  IO Bool -> Sh Bool
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Sh Bool) -> IO Bool -> Sh Bool
forall a b. (a -> b) -> a -> b
$ do
    Bool
file <- [Char] -> IO Bool
doesFileExist [Char]
f
    if Bool
file then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else [Char] -> IO Bool
doesDirectoryExist [Char]
f

-- | Does a path point to an existing file?
test_f :: FilePath -> Sh Bool
test_f :: [Char] -> Sh Bool
test_f = [Char] -> Sh [Char]
absPath ([Char] -> Sh [Char]) -> ([Char] -> Sh Bool) -> [Char] -> Sh Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO Bool -> Sh Bool
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Sh Bool) -> ([Char] -> IO Bool) -> [Char] -> Sh Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO Bool
doesFileExist

-- | Test that a file is in the PATH and also executable
test_px :: FilePath -> Sh Bool
test_px :: [Char] -> Sh Bool
test_px [Char]
exe = do
  Maybe [Char]
mFull <- [Char] -> Sh (Maybe [Char])
which [Char]
exe
  case Maybe [Char]
mFull of
    Maybe [Char]
Nothing -> Bool -> Sh Bool
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just [Char]
full -> IO Bool -> Sh Bool
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Sh Bool) -> IO Bool -> Sh Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
isExecutable [Char]
full

-- | 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 'removeDirectoryRecursive'
rm_rf :: FilePath -> Sh ()
rm_rf :: [Char] -> Sh ()
rm_rf [Char]
infp = do
  [Char]
f <- (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"rm -rf " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Char]
infp
  Bool
isDir <- ([Char] -> Sh Bool
test_d [Char]
f)
  if Bool -> Bool
not Bool
isDir then Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ([Char] -> Sh Bool
test_f [Char]
f) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Sh ()
rm_f [Char]
f
    else
      (IO () -> Sh ()
forall a. IO a -> Sh ()
liftIO_ (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeDirectoryRecursive [Char]
f) Sh () -> (IOError -> Sh ()) -> Sh ()
forall e a. Exception e => Sh a -> (e -> Sh a) -> Sh a
`catch_sh` (\(IOError
e :: IOError) ->
        Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IOError -> Bool
isPermissionError IOError
e) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ do
          [Char] -> Sh [[Char]]
find [Char]
f Sh [[Char]] -> ([[Char]] -> Sh ()) -> Sh ()
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Sh ()) -> [[Char]] -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Char]
file -> IO () -> Sh ()
forall a. IO a -> Sh ()
liftIO_ (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall {m :: * -> *}. MonadIO m => [Char] -> m ()
fixPermissions [Char]
file IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` \SomeException
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeDirectoryRecursive [Char]
f
        )
  where fixPermissions :: [Char] -> m ()
fixPermissions [Char]
file =
          do Permissions
permissions <- IO Permissions -> m Permissions
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Permissions -> m Permissions)
-> IO Permissions -> m Permissions
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Permissions
getPermissions [Char]
file
             let deletable :: Permissions
deletable = Permissions
permissions { readable :: Bool
readable = Bool
True, writable :: Bool
writable = Bool
True, executable :: Bool
executable = Bool
True }
             IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Permissions -> IO ()
setPermissions [Char]
file Permissions
deletable

-- | Remove a file. Does not fail if the file does not exist.
-- Does fail if the file is not a file.
rm_f :: FilePath -> Sh ()
rm_f :: [Char] -> Sh ()
rm_f = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Sh [Char]) -> ([Char] -> Sh ()) -> [Char] -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
f ->
  Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ([Char] -> Sh Bool
test_e [Char]
f) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeFile [Char]
f

-- | Remove a file.
-- Does fail if the file does not exist (use 'rm_f' instead) or is not a file.
rm :: FilePath -> Sh ()
rm :: [Char] -> Sh ()
rm = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Sh [Char]) -> ([Char] -> Sh ()) -> [Char] -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  -- TODO: better error message for removeFile (give takeFileName)
  IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> ([Char] -> IO ()) -> [Char] -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
removeFile

-- | Set an environment variable. The environment is maintained in Sh
-- internally, and is passed to any external commands to be executed.
setenv :: Text -> Text -> Sh ()
setenv :: Text -> Text -> Sh ()
setenv Text
k Text
v = if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
path_env then Text -> Sh ()
setPath Text
v else Text -> Text -> Sh ()
setenvRaw Text
k Text
v

setenvRaw :: Text -> Text -> Sh ()
setenvRaw :: Text -> Text -> Sh ()
setenvRaw Text
k Text
v = (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
x -> State
x { sEnvironment :: [([Char], [Char])]
sEnvironment = [([Char], [Char])] -> [([Char], [Char])]
wibble ([([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ State -> [([Char], [Char])]
sEnvironment State
x }
  where
    normK :: Text
normK = Text -> Text
normalizeEnvVarNameText Text
k
    ([Char]
kStr, [Char]
vStr) = (Text -> [Char]
T.unpack Text
normK, Text -> [Char]
T.unpack Text
v)
    wibble :: [([Char], [Char])] -> [([Char], [Char])]
wibble [([Char], [Char])]
environment = ([Char]
kStr, [Char]
vStr) ([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> [a] -> [a]
: (([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/=[Char]
kStr) ([Char] -> Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], [Char])]
environment

setPath :: Text -> Sh ()
setPath :: Text -> Sh ()
setPath Text
newPath = do
  (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
x -> State
x{ sPathExecutables :: Maybe [([Char], Set [Char])]
sPathExecutables = Maybe [([Char], Set [Char])]
forall a. Maybe a
Nothing }
  Text -> Text -> Sh ()
setenvRaw Text
path_env Text
newPath

path_env :: Text
path_env :: Text
path_env = Text -> Text
normalizeEnvVarNameText Text
"PATH"

-- | Add the filepath onto the PATH env variable.
appendToPath :: FilePath -> Sh ()
appendToPath :: [Char] -> Sh ()
appendToPath = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"appendToPath: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Sh [Char]) -> ([Char] -> Sh ()) -> [Char] -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
filepath -> do
  Text
tp <- [Char] -> Sh Text
toTextWarn [Char]
filepath
  Text
pe <- Text -> Sh Text
get_env_text Text
path_env
  Text -> Sh ()
setPath (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text
pe Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
searchPathSeparator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tp

-- | Prepend the filepath to the PATH env variable.
-- Similar to 'appendToPath' but gives high priority to the filepath instead of low priority.
prependToPath :: FilePath -> Sh ()
prependToPath :: [Char] -> Sh ()
prependToPath = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"prependToPath: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Sh [Char]) -> ([Char] -> Sh ()) -> [Char] -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
filepath -> do
  Text
tp <- [Char] -> Sh Text
toTextWarn [Char]
filepath
  Text
pe <- Text -> Sh Text
get_env_text Text
path_env
  Text -> Sh ()
setPath (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text
tp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
searchPathSeparator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pe

get_environment :: Sh [(String, String)]
get_environment :: Sh [([Char], [Char])]
get_environment = (State -> [([Char], [Char])]) -> Sh [([Char], [Char])]
forall a. (State -> a) -> Sh a
gets State -> [([Char], [Char])]
sEnvironment
{-# DEPRECATED get_environment "use get_env_all" #-}

-- | Get the full environment.
get_env_all :: Sh [(String, String)]
get_env_all :: Sh [([Char], [Char])]
get_env_all = (State -> [([Char], [Char])]) -> Sh [([Char], [Char])]
forall a. (State -> a) -> Sh a
gets State -> [([Char], [Char])]
sEnvironment

normalizeEnvVarNameText :: Text -> Text
#if defined(mingw32_HOST_OS)
-- On Windows, normalize all environment variable names (to lowercase)
-- to account for case insensitivity.
normalizeEnvVarNameText = T.toLower
#else
-- On other systems, keep the variable names as-is.
normalizeEnvVarNameText :: Text -> Text
normalizeEnvVarNameText = Text -> Text
forall a. a -> a
id
#endif

-- | Fetch the current value of an environment variable.
-- If non-existant or empty text, will be 'Nothing'.
get_env :: Text -> Sh (Maybe Text)
get_env :: Text -> Sh (Maybe Text)
get_env Text
k = do
  Maybe Text
mval <- Maybe Text -> Sh (Maybe Text)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Maybe Text -> Sh (Maybe Text))
-> ([([Char], [Char])] -> Maybe Text)
-> [([Char], [Char])]
-> Sh (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Text) -> Maybe [Char] -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack
          (Maybe [Char] -> Maybe Text)
-> ([([Char], [Char])] -> Maybe [Char])
-> [([Char], [Char])]
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> [Char]
T.unpack Text
normK)
          ([([Char], [Char])] -> Sh (Maybe Text))
-> Sh [([Char], [Char])] -> Sh (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (State -> [([Char], [Char])]) -> Sh [([Char], [Char])]
forall a. (State -> a) -> Sh a
gets State -> [([Char], [Char])]
sEnvironment
  Maybe Text -> Sh (Maybe Text)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Sh (Maybe Text)) -> Maybe Text -> Sh (Maybe Text)
forall a b. (a -> b) -> a -> b
$ case Maybe Text
mval of
    Maybe Text
Nothing  -> Maybe Text
forall a. Maybe a
Nothing
    Just Text
val -> if (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
val) then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val else Maybe Text
forall a. Maybe a
Nothing
  where
  normK :: Text
normK = Text -> Text
normalizeEnvVarNameText Text
k

getenv :: Text -> Sh Text
getenv :: Text -> Sh Text
getenv Text
k = Text -> Text -> Sh Text
get_env_def Text
k Text
""
{-# DEPRECATED getenv "use get_env or get_env_text" #-}

-- | Fetch the current value of an environment variable. Both empty and
-- non-existent variables give empty string as a result.
get_env_text :: Text -> Sh Text
get_env_text :: Text -> Sh Text
get_env_text = Text -> Text -> Sh Text
get_env_def Text
""

-- | Fetch the current value of an environment variable. Both empty and
-- non-existent variables give the default 'Text' value as a result.
get_env_def :: Text -> Text -> Sh Text
get_env_def :: Text -> Text -> Sh Text
get_env_def Text
d = Text -> Sh (Maybe Text)
get_env (Text -> Sh (Maybe Text))
-> (Maybe Text -> Sh Text) -> Text -> Sh Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Sh Text
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Sh Text) -> (Maybe Text -> Text) -> Maybe Text -> Sh Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
d
{-# DEPRECATED get_env_def "use fromMaybe DEFAULT get_env" #-}

-- | Apply a single initializer to the two output process handles (stdout and stderr).
initOutputHandles :: HandleInitializer -> StdInit
initOutputHandles :: HandleInitializer -> StdInit
initOutputHandles HandleInitializer
f = HandleInitializer
-> HandleInitializer -> HandleInitializer -> StdInit
StdInit (IO () -> HandleInitializer
forall a b. a -> b -> a
const (IO () -> HandleInitializer) -> IO () -> HandleInitializer
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) HandleInitializer
f HandleInitializer
f

-- | Apply a single initializer to all three standard process handles (stdin, stdout and stderr).
initAllHandles :: HandleInitializer -> StdInit
initAllHandles :: HandleInitializer -> StdInit
initAllHandles HandleInitializer
f = HandleInitializer
-> HandleInitializer -> HandleInitializer -> StdInit
StdInit HandleInitializer
f HandleInitializer
f HandleInitializer
f

-- | When running an external command, apply the given initializers to
-- the specified handles for that command.
-- This can for example be used to change the encoding of the
-- handles or set them into binary mode.
onCommandHandles :: StdInit -> Sh a -> Sh a
onCommandHandles :: forall a. StdInit -> Sh a -> Sh a
onCommandHandles StdInit
initHandles Sh a
a =
    Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
x -> State
x { sInitCommandHandles :: StdInit
sInitCommandHandles = StdInit
initHandles }) Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a

-- | Create a sub-Sh in which external command outputs are not echoed and
-- commands are not printed.
-- See 'sub'.
silently :: Sh a -> Sh a
silently :: forall a. Sh a -> Sh a
silently Sh a
a = Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
x -> State
x
                                { sPrintStdout :: Bool
sPrintStdout = Bool
False
                                , sPrintStderr :: Bool
sPrintStderr = Bool
False
                                , sPrintCommands :: Bool
sPrintCommands = Bool
False
                                }) Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a

-- | Create a sub-Sh in which external command outputs are echoed and
-- Executed commands are printed
-- See 'sub'.
verbosely :: Sh a -> Sh a
verbosely :: forall a. Sh a -> Sh a
verbosely Sh a
a = Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
x -> State
x
                                 { sPrintStdout :: Bool
sPrintStdout = Bool
True
                                 , sPrintStderr :: Bool
sPrintStderr = Bool
True
                                 , sPrintCommands :: Bool
sPrintCommands = Bool
True
                                 }) Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a

-- | Create a sub-Sh in which stdout is sent to the user-defined
-- logger.  When running with 'silently' the given log will not be
-- called for any output. Likewise the log will also not be called for
-- output from 'run_' and 'bash_' commands.
log_stdout_with :: (Text -> IO ()) -> Sh a -> Sh a
log_stdout_with :: forall a. (Text -> IO ()) -> Sh a -> Sh a
log_stdout_with Text -> IO ()
logger Sh a
a = Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
s -> State
s { sPutStdout :: Text -> IO ()
sPutStdout = Text -> IO ()
logger })
                                 Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a

-- | Create a sub-Sh in which stderr is sent to the user-defined
-- logger.  When running with 'silently' the given log will not be
-- called for any output. However, unlike 'log_stdout_with' the log
-- will be called for output from 'run_' and 'bash_' commands.
log_stderr_with :: (Text -> IO ()) -> Sh a -> Sh a
log_stderr_with :: forall a. (Text -> IO ()) -> Sh a -> Sh a
log_stderr_with Text -> IO ()
logger Sh a
a = Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
s -> State
s { sPutStderr :: Text -> IO ()
sPutStderr = Text -> IO ()
logger })
                                 Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a

-- | Create a sub-Sh with stdout printing on or off
-- Defaults to True.
print_stdout :: Bool -> Sh a -> Sh a
print_stdout :: forall a. Bool -> Sh a -> Sh a
print_stdout Bool
shouldPrint Sh a
a =
  Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
x -> State
x { sPrintStdout :: Bool
sPrintStdout = Bool
shouldPrint }) Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a

-- | Create a sub-Sh with stderr printing on or off
-- Defaults to True.
print_stderr :: Bool -> Sh a -> Sh a
print_stderr :: forall a. Bool -> Sh a -> Sh a
print_stderr Bool
shouldPrint Sh a
a =
  Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
x -> State
x { sPrintStderr :: Bool
sPrintStderr = Bool
shouldPrint }) Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a


-- | Create a sub-Sh with command echoing on or off
-- Defaults to False, set to True by 'verbosely'
print_commands :: Bool -> Sh a -> Sh a
print_commands :: forall a. Bool -> Sh a -> Sh a
print_commands Bool
shouldPrint Sh a
a = Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
st -> State
st { sPrintCommands :: Bool
sPrintCommands = Bool
shouldPrint }) Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a

-- | Enter a sub-Sh that inherits the environment
-- The original state will be restored when the sub-Sh completes.
-- Exceptions are propagated normally.
sub :: Sh a -> Sh a
sub :: forall a. Sh a -> Sh a
sub Sh a
a = do
  State
oldState <- Sh State
get
  (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sTrace :: Text
sTrace = Text
T.empty }
  Sh a
a Sh a -> Sh () -> Sh a
forall a b. Sh a -> Sh b -> Sh a
`finally_sh` State -> Sh ()
restoreState State
oldState
  where
    restoreState :: State -> Sh ()
restoreState State
oldState = do
      State
newState <- Sh State
get
      State -> Sh ()
put State
oldState {
         -- avoid losing the log
         sTrace :: Text
sTrace  = State -> Text
sTrace State
oldState Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> State -> Text
sTrace State
newState
         -- latest command execution: not make sense to restore these to old settings
       , sCode :: Int
sCode   = State -> Int
sCode State
newState
       , sStderr :: Text
sStderr = State -> Text
sStderr State
newState
         -- it is questionable what the behavior of stdin should be
       , sStdin :: Maybe Text
sStdin  = State -> Maybe Text
sStdin State
newState
       }

-- | Create a sub-Sh where commands are not traced
-- Defaults to @True@.
-- You should only set to @False@ temporarily for very specific reasons.
tracing :: Bool -> Sh a -> Sh a
tracing :: forall a. Bool -> Sh a -> Sh a
tracing Bool
shouldTrace Sh a
action = Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ do
  (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sTracing :: Bool
sTracing = Bool
shouldTrace }
  Sh a
action

-- | 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.
escaping :: Bool -> Sh a -> Sh a
escaping :: forall a. Bool -> Sh a -> Sh a
escaping Bool
shouldEscape Sh a
action = Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ do
  (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sCommandEscaping :: Bool
sCommandEscaping = Bool
shouldEscape }
  Sh a
action

-- | 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'.
errExit :: Bool -> Sh a -> Sh a
errExit :: forall a. Bool -> Sh a -> Sh a
errExit Bool
shouldExit Sh a
action = Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ do
  (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sErrExit :: Bool
sErrExit = Bool
shouldExit }
  Sh a
action

-- | 'find'-command follows symbolic links. Defaults to @False@.
-- When @True@, follow symbolic links.
-- When @False@, never follow symbolic links.
followSymlink :: Bool -> Sh a -> Sh a
followSymlink :: forall a. Bool -> Sh a -> Sh a
followSymlink Bool
enableFollowSymlink Sh a
action = Sh a -> Sh a
forall a. Sh a -> Sh a
sub (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ do
  (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sFollowSymlink :: Bool
sFollowSymlink = Bool
enableFollowSymlink }
  Sh a
action


defReadOnlyState :: ReadOnlyState
defReadOnlyState :: ReadOnlyState
defReadOnlyState = ReadOnlyState { rosFailToDir :: Bool
rosFailToDir = Bool
False }

-- | 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@).
shellyNoDir :: MonadIO m => Sh a -> m a
shellyNoDir :: forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shellyNoDir = ReadOnlyState -> Sh a -> m a
forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState { rosFailToDir :: Bool
rosFailToDir = Bool
False }
{-# DEPRECATED shellyNoDir "Just use shelly. The default settings have changed" #-}

-- | Using this entry point creates a @.shelly@ directory in the case
-- of failure where errors are recorded.
shellyFailDir :: MonadIO m => Sh a -> m a
shellyFailDir :: forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shellyFailDir = ReadOnlyState -> Sh a -> m a
forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState { rosFailToDir :: Bool
rosFailToDir = Bool
True }

getNormalizedEnvironment :: IO [(String, String)]
getNormalizedEnvironment :: IO [([Char], [Char])]
getNormalizedEnvironment =
#if defined(mingw32_HOST_OS)
  -- On Windows, normalize all environment variable names (to lowercase)
  -- to account for case insensitivity.
  fmap (\(a, b) -> (map toLower a, b)) <$> getEnvironment
#else
  -- On other systems, keep the environment as-is.
  IO [([Char], [Char])]
getEnvironment
#endif

-- | 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.
shelly :: MonadIO m => Sh a -> m a
shelly :: forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly = ReadOnlyState -> Sh a -> m a
forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState
defReadOnlyState

shelly' :: MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' :: forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState
ros Sh a
action = do
  [([Char], [Char])]
environment <- IO [([Char], [Char])] -> m [([Char], [Char])]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [([Char], [Char])]
getNormalizedEnvironment
  [Char]
dir <- IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getCurrentDirectory
  let def :: State
def  = State { sCode :: Int
sCode = Int
0
                   , sStdin :: Maybe Text
sStdin = Maybe Text
forall a. Maybe a
Nothing
                   , sStderr :: Text
sStderr = Text
T.empty
                   , sPutStdout :: Text -> IO ()
sPutStdout = Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stdout
                   , sPutStderr :: Text -> IO ()
sPutStderr = Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr
                   , sPrintStdout :: Bool
sPrintStdout = Bool
True
                   , sPrintStderr :: Bool
sPrintStderr = Bool
True
                   , sPrintCommands :: Bool
sPrintCommands = Bool
False
                   , sInitCommandHandles :: StdInit
sInitCommandHandles = HandleInitializer -> StdInit
initAllHandles (IO () -> HandleInitializer
forall a b. a -> b -> a
const (IO () -> HandleInitializer) -> IO () -> HandleInitializer
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                   , sCommandEscaping :: Bool
sCommandEscaping = Bool
True
                   , sEnvironment :: [([Char], [Char])]
sEnvironment = [([Char], [Char])]
environment
                   , sTracing :: Bool
sTracing = Bool
True
                   , sTrace :: Text
sTrace = Text
T.empty
                   , sDirectory :: [Char]
sDirectory = [Char]
dir
                   , sPathExecutables :: Maybe [([Char], Set [Char])]
sPathExecutables = Maybe [([Char], Set [Char])]
forall a. Maybe a
Nothing
                   , sErrExit :: Bool
sErrExit = Bool
True
                   , sReadOnly :: ReadOnlyState
sReadOnly = ReadOnlyState
ros
                   , sFollowSymlink :: Bool
sFollowSymlink = Bool
False
                   }
  IORef State
stref <- IO (IORef State) -> m (IORef State)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef State) -> m (IORef State))
-> IO (IORef State) -> m (IORef State)
forall a b. (a -> b) -> a -> b
$ State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef State
def
  let caught :: Sh a
caught =
        Sh a
action Sh a -> [ShellyHandler a] -> Sh a
forall a. Sh a -> [ShellyHandler a] -> Sh a
`catches_sh` [
              (ExitCode -> Sh a) -> ShellyHandler a
forall a e. Exception e => (e -> Sh a) -> ShellyHandler a
ShellyHandler (\ExitCode
ex ->
                case ExitCode
ex of
                  ExitCode
ExitSuccess   -> IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO a
forall e a. Exception e => e -> IO a
throwIO ExitCode
ex
                  ExitFailure Int
_ -> ExitCode -> Sh a
forall exception a. Exception exception => exception -> Sh a
throwExplainedException ExitCode
ex
              )
            , (QuietExit -> Sh a) -> ShellyHandler a
forall a e. Exception e => (e -> Sh a) -> ShellyHandler a
ShellyHandler (\QuietExit
ex -> case QuietExit
ex of
                                     QuietExit Int
n -> IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO a
forall e a. Exception e => e -> IO a
throwIO (ExitCode -> IO a) -> ExitCode -> IO a
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
n)
            , (SomeException -> Sh a) -> ShellyHandler a
forall a e. Exception e => (e -> Sh a) -> ShellyHandler a
ShellyHandler (\(SomeException
ex::SomeException) -> SomeException -> Sh a
forall exception a. Exception exception => exception -> Sh a
throwExplainedException SomeException
ex)
          ]
  IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Sh a -> IORef State -> IO a
forall a. Sh a -> IORef State -> IO a
runSh Sh a
caught IORef State
stref
  where
    throwExplainedException :: Exception exception => exception -> Sh a
    throwExplainedException :: forall exception a. Exception exception => exception -> Sh a
throwExplainedException exception
ex = Sh State
get Sh State -> (State -> Sh [Char]) -> Sh [Char]
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State -> Sh [Char]
errorMsg Sh [Char] -> ([Char] -> Sh a) -> Sh a
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> ([Char] -> IO a) -> [Char] -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReThrownException exception -> IO a
forall e a. Exception e => e -> IO a
throwIO (ReThrownException exception -> IO a)
-> ([Char] -> ReThrownException exception) -> [Char] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. exception -> [Char] -> ReThrownException exception
forall e. e -> [Char] -> ReThrownException e
ReThrownException exception
ex

    errorMsg :: State -> Sh [Char]
errorMsg State
st =
      if Bool -> Bool
not (ReadOnlyState -> Bool
rosFailToDir (ReadOnlyState -> Bool) -> ReadOnlyState -> Bool
forall a b. (a -> b) -> a -> b
$ State -> ReadOnlyState
sReadOnly State
st) then Sh [Char]
ranCommands else do
          [Char]
d <- Sh [Char]
pwd
          [Char]
sf <- Sh [Char]
shellyFile
          let logFile :: [Char]
logFile = [Char]
d[Char] -> [Char] -> [Char]
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</>[Char]
shelly_dir[Char] -> [Char] -> [Char]
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</>[Char]
sf
          ([Char] -> Text -> Sh ()
writefile [Char]
logFile Text
trc Sh () -> Sh [Char] -> Sh [Char]
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Sh [Char]
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"log of commands saved to: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
logFile))
            Sh [Char] -> (SomeException -> Sh [Char]) -> Sh [Char]
forall a. Sh a -> (SomeException -> Sh a) -> Sh a
`catchany_sh` (\SomeException
_ -> Sh [Char]
ranCommands)

      where
        trc :: Text
trc = State -> Text
sTrace State
st
        ranCommands :: Sh [Char]
ranCommands = [Char] -> Sh [Char]
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Sh [Char]) -> (Text -> [Char]) -> Text -> Sh [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
forall a. Monoid a => a -> a -> a
mappend [Char]
"Ran commands: \n" ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> Sh [Char]) -> Text -> Sh [Char]
forall a b. (a -> b) -> a -> b
$ Text
trc

    shelly_dir :: [Char]
shelly_dir = [Char]
".shelly"
    shellyFile :: Sh [Char]
shellyFile = [Char] -> Sh [Char] -> Sh [Char]
forall a. [Char] -> Sh a -> Sh a
chdir_p [Char]
shelly_dir (Sh [Char] -> Sh [Char]) -> Sh [Char] -> Sh [Char]
forall a b. (a -> b) -> a -> b
$ do
      [[Char]]
fs <- [Char] -> Sh [[Char]]
ls [Char]
"."
      [Char] -> Sh [Char]
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Sh [Char]) -> [Char] -> Sh [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
pack ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show ([[Char]] -> Int
nextNum [[Char]]
fs) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".txt"

    nextNum :: [FilePath] -> Int
    nextNum :: [[Char]] -> Int
nextNum [] = Int
1
    nextNum [[Char]]
fs = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> ([[Char]] -> Int) -> [[Char]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([[Char]] -> [Int]) -> [[Char]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Char] -> Int
forall a. Read a => a -> [Char] -> a
readDef Int
1 ([Char] -> Int) -> ([Char] -> [Char]) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeFileName) ([[Char]] -> Int) -> [[Char]] -> Int
forall a b. (a -> b) -> a -> b
$ [[Char]]
fs

-- from safe package
readDef :: Read a => a -> String -> a
readDef :: forall a. Read a => a -> [Char] -> a
readDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> ([Char] -> Maybe a) -> [Char] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMay
  where
    readMay :: Read a => String -> Maybe a
    readMay :: forall a. Read a => [Char] -> Maybe a
readMay [Char]
s = case [a
x | (a
x,[Char]
t) <- ReadS a
forall a. Read a => ReadS a
reads [Char]
s, ([Char]
"",[Char]
"") <- ReadS [Char]
lex [Char]
t] of
                  [a
x] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                  [a]
_ -> Maybe a
forall a. Maybe a
Nothing

data RunFailed = RunFailed FilePath [Text] Int Text deriving (Typeable)

instance Show RunFailed where
  show :: RunFailed -> [Char]
show (RunFailed [Char]
exe [Text]
args Int
code Text
errs) =
    let codeMsg :: [Char]
codeMsg = case Int
code of
          Int
127 -> [Char]
". exit code 127 usually means the command does not exist (in the PATH)"
          Int
_ -> [Char]
""
    in [Char]
"error running: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack ([Char] -> [Text] -> Text
show_command [Char]
exe [Text]
args) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
         [Char]
"\nexit status: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
code [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
codeMsg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\nstderr: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
errs

instance Exception RunFailed

show_command :: FilePath -> [Text] -> Text
show_command :: [Char] -> [Text] -> Text
show_command [Char]
exe [Text]
args =
  let escape :: Char -> Text
escape Char
char | Char
char Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
specialsInQuotes = [Char] -> Text
T.pack [Char
'\\', Char
char]
      escape Char
char = Char -> Text
T.singleton Char
char
      quote :: Text -> Text
quote Text
arg = Char -> Text -> Text
surround Char
'"' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escape Text
arg
      isSafe :: Char -> Bool
isSafe Char
c = ((Char -> Bool) -> Bool) -> [Char -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Char
c) [Char -> Bool
isPrint, Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace, (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Char
specials)]
      showArg :: Text -> Text
showArg Text
"" = Char -> Text -> Text
surround Char
'"' Text
""
      showArg Text
arg | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSafe Text
arg = Text
arg
      showArg Text
arg = Text -> Text
quote Text
arg
  in Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
showArg ([Char] -> Text
toTextIgnore [Char]
exe Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)

-- | Characters that need to be escaped or quoted to retain their literal value.
specials :: Set.Set Char
specials :: Set Char
specials = [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList [Char]
"\\'\"`$&|;(){}<>"

-- | When inside quotes, characters that need to be escaped to retain their
-- literal value.
specialsInQuotes :: Set.Set Char
specialsInQuotes :: Set Char
specialsInQuotes = [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList [Char]
"\\\"`$"

-- quote one argument
quoteOne :: Text -> Text
quoteOne :: Text -> Text
quoteOne Text
t =
    Char -> Text -> Text
surround Char
'\'' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"'" Text
"'\\''" Text
t


-- returns a string that can be executed by a shell.
-- NOTE: all parts are treated literally, which means that
-- things like variable expansion will not be available.
quoteCommand :: FilePath -> [Text] -> Text
quoteCommand :: [Char] -> [Text] -> Text
quoteCommand [Char]
exe [Text]
args =
    Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quoteOne ([Char] -> Text
toTextIgnore [Char]
exe Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)

surround :: Char -> Text -> Text
surround :: Char -> Text -> Text
surround Char
c Text
t = Char -> Text -> Text
T.cons Char
c (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
T.snoc Text
t Char
c

data SshMode = ParSsh | SeqSsh

-- | Same as 'sshPairs', but returns @()@.
sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh ()
sshPairs_ :: Text -> [([Char], [Text])] -> Sh ()
sshPairs_ Text
_ [] = () -> Sh ()
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sshPairs_ Text
server [([Char], [Text])]
cmds = ([Char] -> [Text] -> Sh ()) -> Text -> [([Char], [Text])] -> Sh ()
forall a.
([Char] -> [Text] -> Sh a) -> Text -> [([Char], [Text])] -> Sh a
sshPairs' [Char] -> [Text] -> Sh ()
run_ Text
server [([Char], [Text])]
cmds

-- | Same as 'sshPairsPar', but returns @()@.
sshPairsPar_ :: Text -> [(FilePath, [Text])] -> Sh ()
sshPairsPar_ :: Text -> [([Char], [Text])] -> Sh ()
sshPairsPar_ Text
_ [] = () -> Sh ()
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sshPairsPar_ Text
server [([Char], [Text])]
cmds = ([Char] -> [Text] -> Sh ()) -> Text -> [([Char], [Text])] -> Sh ()
forall a.
([Char] -> [Text] -> Sh a) -> Text -> [([Char], [Text])] -> Sh a
sshPairsPar' [Char] -> [Text] -> Sh ()
run_ Text
server [([Char], [Text])]
cmds

-- | 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, and the remote commands are
-- quoted with single quotes, in a way such that the remote commands will see
-- the literal values you passed, this means that no variable expansion and
-- alike will done on either the local shell or the remote shell, and that
-- if there are a single or double quotes in your arguments, they need not
-- to be quoted manually.
--
-- Internally the list of commands are combined with the string @&&@ before given to @ssh@.
sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text
sshPairs :: Text -> [([Char], [Text])] -> Sh Text
sshPairs Text
_ [] = Text -> Sh Text
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairs Text
server [([Char], [Text])]
cmds = ([Char] -> [Text] -> Sh Text)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh Text
forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh Text
run Text
server [] [([Char], [Text])]
cmds SshMode
SeqSsh

-- | Same as 'sshPairs', but combines commands with the string @&@,
-- so they will be started in parallel.
sshPairsPar :: Text -> [(FilePath, [Text])] -> Sh Text
sshPairsPar :: Text -> [([Char], [Text])] -> Sh Text
sshPairsPar Text
_ [] = Text -> Sh Text
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairsPar Text
server [([Char], [Text])]
cmds = ([Char] -> [Text] -> Sh Text)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh Text
forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh Text
run Text
server [] [([Char], [Text])]
cmds SshMode
ParSsh

sshPairsPar' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
sshPairsPar' :: forall a.
([Char] -> [Text] -> Sh a) -> Text -> [([Char], [Text])] -> Sh a
sshPairsPar' [Char] -> [Text] -> Sh a
run' Text
server [([Char], [Text])]
actions = ([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh a
run' Text
server [] [([Char], [Text])]
actions SshMode
ParSsh

sshPairs' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
sshPairs' :: forall a.
([Char] -> [Text] -> Sh a) -> Text -> [([Char], [Text])] -> Sh a
sshPairs' [Char] -> [Text] -> Sh a
run' Text
server [([Char], [Text])]
actions = ([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh a
run' Text
server [] [([Char], [Text])]
actions SshMode
SeqSsh

-- | Like 'sshPairs', but allows for arguments to the call to @ssh@.
sshPairsWithOptions :: Text                  -- ^ Server name.
                    -> [Text]                -- ^ Arguments to @ssh@ (e.g. @["-p","22"]@).
                    -> [(FilePath, [Text])]  -- ^ Pairs of commands to run on the remote.
                    -> Sh Text               -- ^ Returns the standard output.
sshPairsWithOptions :: Text -> [Text] -> [([Char], [Text])] -> Sh Text
sshPairsWithOptions Text
_ [Text]
_ [] = Text -> Sh Text
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairsWithOptions Text
server [Text]
sshargs [([Char], [Text])]
cmds = ([Char] -> [Text] -> Sh Text)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh Text
forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh Text
run Text
server [Text]
sshargs [([Char], [Text])]
cmds SshMode
SeqSsh

sshPairsWithOptions' :: (FilePath -> [Text] -> Sh a) -> Text -> [Text] -> [(FilePath, [Text])] -> SshMode  -> Sh a
sshPairsWithOptions' :: forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh a
run' Text
server [Text]
sshargs [([Char], [Text])]
actions SshMode
mode = Bool -> Sh a -> Sh a
forall a. Bool -> Sh a -> Sh a
escaping Bool
False (Sh a -> Sh a) -> Sh a -> Sh a
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> [Text] -> Sh a
run' [Char]
"ssh" ([Text
server] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sshargs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [[([Char], [Text])] -> SshMode -> Text
sshCommandText [([Char], [Text])]
actions SshMode
mode])

sshCommandText :: [(FilePath, [Text])] -> SshMode -> Text
sshCommandText :: [([Char], [Text])] -> SshMode -> Text
sshCommandText [([Char], [Text])]
actions SshMode
mode =
    Text -> Text
quoteOne ((Text -> Text -> Text) -> [Text] -> Text
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Text -> Text -> Text
joiner ((([Char], [Text]) -> Text) -> [([Char], [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> [Text] -> Text) -> ([Char], [Text]) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> [Text] -> Text
quoteCommand) [([Char], [Text])]
actions))
  where
    joiner :: Text -> Text -> Text
joiner Text
memo Text
next = case SshMode
mode of
        SshMode
SeqSsh -> Text
memo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" && " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
next
        SshMode
ParSsh -> Text
memo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" & " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
next

data QuietExit = QuietExit Int deriving (Int -> QuietExit -> [Char] -> [Char]
[QuietExit] -> [Char] -> [Char]
QuietExit -> [Char]
(Int -> QuietExit -> [Char] -> [Char])
-> (QuietExit -> [Char])
-> ([QuietExit] -> [Char] -> [Char])
-> Show QuietExit
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> QuietExit -> [Char] -> [Char]
showsPrec :: Int -> QuietExit -> [Char] -> [Char]
$cshow :: QuietExit -> [Char]
show :: QuietExit -> [Char]
$cshowList :: [QuietExit] -> [Char] -> [Char]
showList :: [QuietExit] -> [Char] -> [Char]
Show, Typeable)
instance Exception QuietExit

-- | Shelly's wrapper around exceptions thrown in its monad
data ReThrownException e = ReThrownException e String deriving (Typeable)
instance Exception e => Exception (ReThrownException e)
instance Exception e => Show (ReThrownException e) where
  show :: ReThrownException e -> [Char]
show (ReThrownException e
ex [Char]
msg) = [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
    [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Exception: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ e -> [Char]
forall a. Show a => a -> [Char]
show e
ex

-- | 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'. If the output does not end with a newline, it is automatically added.
--
-- 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 Text
run :: [Char] -> [Text] -> Sh Text
run [Char]
fp [Text]
args = Text -> Sh Text
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Sh Text) -> (Seq Text -> Text) -> Seq Text -> Sh Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> Text
lineSeqToText (Seq Text -> Sh Text) -> Sh (Seq Text) -> Sh Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Seq Text
-> FoldCallback (Seq Text) -> [Char] -> [Text] -> Sh (Seq Text)
forall a. a -> FoldCallback a -> [Char] -> [Text] -> Sh a
runFoldLines Seq Text
forall a. Monoid a => a
mempty FoldCallback (Seq Text)
forall a. Seq a -> a -> Seq a
(|>) [Char]
fp [Text]
args

-- | Like 'run', but it invokes the user-requested program with @bash@.
bash :: FilePath -> [Text] -> Sh Text
bash :: [Char] -> [Text] -> Sh Text
bash [Char]
fp [Text]
args = Bool -> Sh Text -> Sh Text
forall a. Bool -> Sh a -> Sh a
escaping Bool
False (Sh Text -> Sh Text) -> Sh Text -> Sh Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> Sh Text
run [Char]
"bash" ([Text] -> Sh Text) -> [Text] -> Sh Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> [Text]
bashArgs [Char]
fp [Text]
args

bash_ :: FilePath -> [Text] -> Sh ()
bash_ :: [Char] -> [Text] -> Sh ()
bash_ [Char]
fp [Text]
args = Bool -> Sh () -> Sh ()
forall a. Bool -> Sh a -> Sh a
escaping Bool
False (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> Sh ()
run_ [Char]
"bash" ([Text] -> Sh ()) -> [Text] -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> [Text]
bashArgs [Char]
fp [Text]
args

bashArgs :: FilePath -> [Text] -> [Text]
bashArgs :: [Char] -> [Text] -> [Text]
bashArgs [Char]
fp [Text]
args = [Text
"-c", Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
sanitise ([Char] -> Text
toTextIgnore [Char]
fp Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"]
  where
    sanitise :: [Text] -> Text
sanitise = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"'" Text
"\'" (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
" "

-- | Use this with 'bash' to set @pipefail@.
--
-- > bashPipeFail $ bash "echo foo | echo"
bashPipeFail :: (FilePath -> [Text] -> Sh a) -> FilePath -> [Text] -> Sh a
bashPipeFail :: forall a. ([Char] -> [Text] -> Sh a) -> [Char] -> [Text] -> Sh a
bashPipeFail [Char] -> [Text] -> Sh a
runner [Char]
fp [Text]
args = [Char] -> [Text] -> Sh a
runner [Char]
"set -o pipefail;" ([Char] -> Text
toTextIgnore [Char]
fp Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)

-- | Bind some arguments to 'run' for re-use. Example:
--
-- > monit = command "monit" ["-c", "monitrc"]
-- > monit ["stop", "program"]
command :: FilePath -> [Text] -> [Text] -> Sh Text
command :: [Char] -> [Text] -> [Text] -> Sh Text
command [Char]
com [Text]
args [Text]
more_args = [Char] -> [Text] -> Sh Text
run [Char]
com ([Text]
args [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
more_args)

-- | Bind some arguments to 'run_' for re-use. Example:
--
-- > monit_ = command_ "monit" ["-c", "monitrc"]
-- > monit_ ["stop", "program"]
command_ :: FilePath -> [Text] -> [Text] -> Sh ()
command_ :: [Char] -> [Text] -> [Text] -> Sh ()
command_ [Char]
com [Text]
args [Text]
more_args = [Char] -> [Text] -> Sh ()
run_ [Char]
com ([Text]
args [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
more_args)

-- | 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 Text
command1 :: [Char] -> [Text] -> Text -> [Text] -> Sh Text
command1 [Char]
com [Text]
args Text
one_arg [Text]
more_args = [Char] -> [Text] -> Sh Text
run [Char]
com ([Text]
args [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
one_arg] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
more_args)

-- | 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 ()
command1_ :: [Char] -> [Text] -> Text -> [Text] -> Sh ()
command1_ [Char]
com [Text]
args Text
one_arg [Text]
more_args = [Char] -> [Text] -> Sh ()
run_ [Char]
com ([Text]
args [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
one_arg] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
more_args)

-- | The same as 'run', but return @()@ instead of the stdout content.
-- The stdout will be read and discarded line-by-line.
run_ :: FilePath -> [Text] -> Sh ()
run_ :: [Char] -> [Text] -> Sh ()
run_ [Char]
exe [Text]
args = do
    State
state <- Sh State
get
    if State -> Bool
sPrintStdout State
state
      then Sh ()
runWithColor_
      else () -> FoldCallback () -> [Char] -> [Text] -> Sh ()
forall a. a -> FoldCallback a -> [Char] -> [Text] -> Sh a
runFoldLines () (\()
_ Text
_ -> ()) [Char]
exe [Text]
args
  where
    -- same a runFoldLines except Inherit Stdout
    -- That allows color to show up
    runWithColor_ :: Sh ()
runWithColor_ =
        [Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh ())
-> Sh ()
forall a.
[Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles [Char]
exe [Text]
args [StdStream -> StdHandle
OutHandle StdStream
Inherit] ((Handle -> Handle -> Handle -> Sh ()) -> Sh ())
-> (Handle -> Handle -> Handle -> Sh ()) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \Handle
inH Handle
_ Handle
errH -> do
          State
state <- Sh State
get
          Text
errs <- IO Text -> Sh Text
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> Sh Text) -> IO Text -> Sh Text
forall a b. (a -> b) -> a -> b
$ do
            HandleInitializer
hClose Handle
inH -- setStdin was taken care of before the process even ran
            Async (Seq Text)
errVar <- (Seq Text
-> FoldCallback (Seq Text)
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async (Seq Text))
forall a.
a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar Seq Text
forall a. Monoid a => a
mempty FoldCallback (Seq Text)
forall a. Seq a -> a -> Seq a
(|>) Handle
errH (State -> Text -> IO ()
sPutStderr State
state) (State -> Bool
sPrintStderr State
state))
            Seq Text -> Text
lineSeqToText (Seq Text -> Text) -> IO (Seq Text) -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Async (Seq Text) -> IO (Seq Text)
forall a. Async a -> IO a
wait Async (Seq Text)
errVar
          (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
state' -> State
state' { sStderr :: Text
sStderr = Text
errs }
          () -> Sh ()
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

liftIO_ :: IO a -> Sh ()
liftIO_ :: forall a. IO a -> Sh ()
liftIO_ = Sh a -> Sh ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sh a -> Sh ()) -> (IO a -> Sh a) -> IO a -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Similar to 'run' but gives the raw stdout handle in a callback.
-- If you want even more control, use 'runHandles'.
runHandle :: FilePath         -- ^ Command.
          -> [Text]           -- ^ Arguments.
          -> (Handle -> Sh a) -- ^ 'stdout' handle.
          -> Sh a
runHandle :: forall a. [Char] -> [Text] -> (Handle -> Sh a) -> Sh a
runHandle [Char]
exe [Text]
args Handle -> Sh a
withHandle = [Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
forall a.
[Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles [Char]
exe [Text]
args [] ((Handle -> Handle -> Handle -> Sh a) -> Sh a)
-> (Handle -> Handle -> Handle -> Sh a) -> Sh a
forall a b. (a -> b) -> a -> b
$ \Handle
_ Handle
outH Handle
errH -> do
    State
state <- Sh State
get
    Async (Seq Text)
errVar <- IO (Async (Seq Text)) -> Sh (Async (Seq Text))
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async (Seq Text)) -> Sh (Async (Seq Text)))
-> IO (Async (Seq Text)) -> Sh (Async (Seq Text))
forall a b. (a -> b) -> a -> b
$
      (Seq Text
-> FoldCallback (Seq Text)
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async (Seq Text))
forall a.
a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar Seq Text
forall a. Monoid a => a
mempty FoldCallback (Seq Text)
forall a. Seq a -> a -> Seq a
(|>) Handle
errH (State -> Text -> IO ()
sPutStderr State
state) (State -> Bool
sPrintStderr State
state))
    a
res <- Handle -> Sh a
withHandle Handle
outH
    Text
errs <- IO Text -> Sh Text
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> Sh Text) -> IO Text -> Sh Text
forall a b. (a -> b) -> a -> b
$ Seq Text -> Text
lineSeqToText (Seq Text -> Text) -> IO (Seq Text) -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Async (Seq Text) -> IO (Seq Text)
forall a. Async a -> IO a
wait Async (Seq Text)
errVar
    (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
state' -> State
state' { sStderr :: Text
sStderr = Text
errs }
    a -> Sh a
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

-- | 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.
runHandles
  :: 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
runHandles :: forall a.
[Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles [Char]
exe [Text]
args [StdHandle]
reusedHandles Handle -> Handle -> Handle -> Sh a
withHandles = do
    -- clear stdin before beginning command execution
    State
origstate <- Sh State
get
    let mStdin :: Maybe Text
mStdin = State -> Maybe Text
sStdin State
origstate
    State -> Sh ()
put (State -> Sh ()) -> State -> Sh ()
forall a b. (a -> b) -> a -> b
$ State
origstate { sStdin :: Maybe Text
sStdin = Maybe Text
forall a. Maybe a
Nothing, sCode :: Int
sCode = Int
0, sStderr :: Text
sStderr = Text
T.empty }
    State
state <- Sh State
get

    let cmdString :: Text
cmdString = [Char] -> [Text] -> Text
show_command [Char]
exe [Text]
args
    Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (State -> Bool
sPrintCommands State
state) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text -> Sh ()
echo Text
cmdString
    Text -> Sh ()
trace Text
cmdString

    let doRun :: [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
doRun = if State -> Bool
sCommandEscaping State
state then [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand else [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommandNoEscape

    Sh (Handle, Handle, Handle, ProcessHandle)
-> ((Handle, Handle, Handle, ProcessHandle) -> Sh ())
-> ((Handle, Handle, Handle, ProcessHandle) -> Sh a)
-> Sh a
forall a b c. Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
bracket_sh
      ([StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
doRun [StdHandle]
reusedHandles State
state [Char]
exe [Text]
args)
      (\(Handle
_,Handle
_,Handle
_,ProcessHandle
procH) -> (IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ()
terminateProcess ProcessHandle
procH))
      (\(Handle
inH,Handle
outH,Handle
errH,ProcessHandle
procH) -> do

        IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ do
          StdInit -> HandleInitializer
inInit (State -> StdInit
sInitCommandHandles State
state) Handle
inH
          StdInit -> HandleInitializer
outInit (State -> StdInit
sInitCommandHandles State
state) Handle
outH
          StdInit -> HandleInitializer
errInit (State -> StdInit
sInitCommandHandles State
state) Handle
errH

        IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ case Maybe Text
mStdin of
          Just Text
input -> Handle -> Text -> IO ()
TIO.hPutStr Handle
inH Text
input
          Maybe Text
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        a
result <- Handle -> Handle -> Handle -> Sh a
withHandles Handle
inH Handle
outH Handle
errH

        (ExitCode
ex, Int
code) <- IO (ExitCode, Int) -> Sh (ExitCode, Int)
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, Int) -> Sh (ExitCode, Int))
-> IO (ExitCode, Int) -> Sh (ExitCode, Int)
forall a b. (a -> b) -> a -> b
$ do
          ExitCode
ex' <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
procH

          -- TODO: specifically catch our own error for Inherit pipes
          HandleInitializer
hClose Handle
outH IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          HandleInitializer
hClose Handle
errH IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          HandleInitializer
hClose Handle
inH IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

          (ExitCode, Int) -> IO (ExitCode, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExitCode, Int) -> IO (ExitCode, Int))
-> (ExitCode, Int) -> IO (ExitCode, Int)
forall a b. (a -> b) -> a -> b
$ case ExitCode
ex' of
            ExitCode
ExitSuccess -> (ExitCode
ex', Int
0)
            ExitFailure Int
n -> (ExitCode
ex', Int
n)

        (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
state' -> State
state' { sCode :: Int
sCode = Int
code }

        case (State -> Bool
sErrExit State
state, ExitCode
ex) of
          (Bool
True,  ExitFailure Int
n) -> do
              State
newState <- Sh State
get
              IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ RunFailed -> IO a
forall e a. Exception e => e -> IO a
throwIO (RunFailed -> IO a) -> RunFailed -> IO a
forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> Int -> Text -> RunFailed
RunFailed [Char]
exe [Text]
args Int
n (State -> Text
sStderr State
newState)
          (Bool, ExitCode)
_                      -> a -> Sh a
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
      )


-- | Used by 'run'. Folds 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.
runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> Sh a
runFoldLines :: forall a. a -> FoldCallback a -> [Char] -> [Text] -> Sh a
runFoldLines a
start FoldCallback a
cb [Char]
exe [Text]
args =
  [Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
forall a.
[Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles [Char]
exe [Text]
args [] ((Handle -> Handle -> Handle -> Sh a) -> Sh a)
-> (Handle -> Handle -> Handle -> Sh a) -> Sh a
forall a b. (a -> b) -> a -> b
$ \Handle
inH Handle
outH Handle
errH -> do
    State
state <- Sh State
get
    (Async (Seq Text)
errVar, Async a
outVar) <- IO (Async (Seq Text), Async a) -> Sh (Async (Seq Text), Async a)
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async (Seq Text), Async a) -> Sh (Async (Seq Text), Async a))
-> IO (Async (Seq Text), Async a) -> Sh (Async (Seq Text), Async a)
forall a b. (a -> b) -> a -> b
$ do
      HandleInitializer
hClose Handle
inH -- setStdin was taken care of before the process even ran
      (Async (Seq Text) -> Async a -> (Async (Seq Text), Async a))
-> IO (Async (Seq Text))
-> IO (Async a)
-> IO (Async (Seq Text), Async a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
          (Seq Text
-> FoldCallback (Seq Text)
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async (Seq Text))
forall a.
a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar Seq Text
forall a. Monoid a => a
mempty FoldCallback (Seq Text)
forall a. Seq a -> a -> Seq a
(|>) Handle
errH (State -> Text -> IO ()
sPutStderr State
state) (State -> Bool
sPrintStderr State
state))
          (a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
forall a.
a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar a
start FoldCallback a
cb Handle
outH (State -> Text -> IO ()
sPutStdout State
state) (State -> Bool
sPrintStdout State
state))
    Text
errs <- IO Text -> Sh Text
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> Sh Text) -> IO Text -> Sh Text
forall a b. (a -> b) -> a -> b
$ Seq Text -> Text
lineSeqToText (Seq Text -> Text) -> IO (Seq Text) -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Async (Seq Text) -> IO (Seq Text)
forall a. Async a -> IO a
wait Async (Seq Text)
errVar
    (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
state' -> State
state' { sStderr :: Text
sStderr = Text
errs }
    IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ Async a -> IO a
forall a. Async a -> IO a
wait Async a
outVar


putHandleIntoMVar
  :: a -> FoldCallback a
  -> Handle           -- ^ Out handle.
  -> (Text -> IO ())  -- ^ In handle.
  -> Bool             -- ^ Should it be printed while transfered?
  -> IO (Async a)
putHandleIntoMVar :: forall a.
a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar a
start FoldCallback a
cb Handle
outH Text -> IO ()
putWrite Bool
shouldPrint = IO (Async a) -> IO (Async a)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async a) -> IO (Async a)) -> IO (Async a) -> IO (Async a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Async a)
forall a. IO a -> IO (Async a)
async (IO a -> IO (Async a)) -> IO a -> IO (Async a)
forall a b. (a -> b) -> a -> b
$ do
  if Bool
shouldPrint
    then a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
forall a. a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
transferFoldHandleLines a
start FoldCallback a
cb Handle
outH Text -> IO ()
putWrite
    else a -> FoldCallback a -> Handle -> IO a
forall a. a -> FoldCallback a -> Handle -> IO a
foldHandleLines a
start FoldCallback a
cb Handle
outH


-- | The output of last external command. See 'run'.
lastStderr :: Sh Text
lastStderr :: Sh Text
lastStderr = (State -> Text) -> Sh Text
forall a. (State -> a) -> Sh a
gets State -> Text
sStderr

-- | 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.
lastExitCode :: Sh Int
lastExitCode :: Sh Int
lastExitCode = (State -> Int) -> Sh Int
forall a. (State -> a) -> Sh a
gets State -> Int
sCode

-- | Set the 'stdin' to be used and cleared by the next 'run'.
setStdin :: Text -> Sh ()
setStdin :: Text -> Sh ()
setStdin Text
input = (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sStdin :: Maybe Text
sStdin = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
input }

-- | 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.
(-|-) :: Sh Text -> Sh b -> Sh b
Sh Text
one -|- :: forall b. Sh Text -> Sh b -> Sh b
-|- Sh b
two = do
  Text
res <- Bool -> Sh Text -> Sh Text
forall a. Bool -> Sh a -> Sh a
print_stdout Bool
False Sh Text
one
  Text -> Sh ()
setStdin Text
res
  Sh b
two

-- | Copy a file, or a directory recursively.
-- Uses 'cp'.
cp_r :: FilePath -> FilePath -> Sh ()
cp_r :: [Char] -> [Char] -> Sh ()
cp_r [Char]
from' [Char]
to' = do
    [Char]
from <- [Char] -> Sh [Char]
absPath [Char]
from'
    Bool
fromIsDir <- ([Char] -> Sh Bool
test_d [Char]
from)
    if Bool -> Bool
not Bool
fromIsDir then Bool -> [Char] -> [Char] -> Sh ()
cp_should_follow_symlinks Bool
False [Char]
from' [Char]
to' else do
       Text -> Sh ()
trace (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text
"cp_r " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
to'
       [Char]
to <- [Char] -> Sh [Char]
absPath [Char]
to'
       Bool
toIsDir <- [Char] -> Sh Bool
test_d [Char]
to

       Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
from [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
to) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError ([Char] -> IOError) -> [Char] -> IOError
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. Show a => a -> [Char]
show (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text
"cp_r: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
         [Char] -> Text
toTextIgnore [Char]
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
to Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are identical"

       [Char]
finalTo <- if Bool -> Bool
not Bool
toIsDir then do
            [Char] -> Sh ()
mkdir [Char]
to
            [Char] -> Sh [Char]
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
to
          else do
            -- this takes the name of the from directory
            -- because filepath has no builtin function like `dirname`
            let d :: [Char]
d = [Char]
to [Char] -> [Char] -> [Char]
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</> ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitPath ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeDirectory ([Char] -> [Char]
addTrailingPathSeparator [Char]
from))
            [Char] -> Sh ()
mkdir_p [Char]
d Sh () -> Sh [Char] -> Sh [Char]
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Sh [Char]
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
d
       [Char] -> Sh [[Char]]
ls [Char]
from Sh [[Char]] -> ([[Char]] -> Sh ()) -> Sh ()
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Sh ()) -> [[Char]] -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Char]
item -> do
         [Char] -> [Char] -> Sh ()
cp_r ([Char]
from [Char] -> [Char] -> [Char]
FP.</> [Char] -> [Char]
takeFileName [Char]
item) ([Char]
finalTo [Char] -> [Char] -> [Char]
FP.</> [Char] -> [Char]
takeFileName [Char]
item))

-- | Copy a file. The second path could be a directory, in which case the
-- original file name is used, in that directory.
cp :: FilePath -> FilePath -> Sh ()
cp :: [Char] -> [Char] -> Sh ()
cp = Bool -> [Char] -> [Char] -> Sh ()
cp_should_follow_symlinks Bool
True

cp_should_follow_symlinks :: Bool -> FilePath -> FilePath -> Sh ()
cp_should_follow_symlinks :: Bool -> [Char] -> [Char] -> Sh ()
cp_should_follow_symlinks Bool
shouldFollowSymlinks [Char]
from' [Char]
to' = do
  [Char]
from <- [Char] -> Sh [Char]
absPath [Char]
from'
  [Char]
to <- [Char] -> Sh [Char]
absPath [Char]
to'
  Text -> Sh ()
trace (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text
"cp " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
to
  Bool
to_dir <- [Char] -> Sh Bool
test_d [Char]
to
  let to_loc :: [Char]
to_loc = if Bool
to_dir then [Char]
to [Char] -> [Char] -> [Char]
FP.</> [Char] -> [Char]
takeFileName [Char]
from else [Char]
to
  if Bool
shouldFollowSymlinks then [Char] -> [Char] -> Sh ()
forall {m :: * -> *}. MonadIO m => [Char] -> [Char] -> m ()
copyNormal [Char]
from [Char]
to_loc else do
    Bool
isSymlink <- IO Bool -> Sh Bool
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Sh Bool) -> IO Bool -> Sh Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
pathIsSymbolicLink [Char]
from
    if Bool -> Bool
not Bool
isSymlink then [Char] -> [Char] -> Sh ()
forall {m :: * -> *}. MonadIO m => [Char] -> [Char] -> m ()
copyNormal [Char]
from [Char]
to_loc else do
      [Char]
target <- IO [Char] -> Sh [Char]
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> Sh [Char]) -> IO [Char] -> Sh [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
getSymbolicLinkTarget [Char]
from
      IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
createFileLink [Char]
target [Char]
to_loc
  where
    extraMsg :: String -> String -> String
    extraMsg :: [Char] -> [Char] -> [Char]
extraMsg [Char]
t [Char]
f = [Char]
"during copy from: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" to: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t
    copyNormal :: [Char] -> [Char] -> m ()
copyNormal [Char]
from [Char]
to = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
copyFile [Char]
from [Char]
to IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (\SomeException
e -> ReThrownException SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ReThrownException SomeException -> IO ())
-> ReThrownException SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$
          SomeException -> [Char] -> ReThrownException SomeException
forall e. e -> [Char] -> ReThrownException e
ReThrownException SomeException
e ([Char] -> [Char] -> [Char]
extraMsg [Char]
to [Char]
from)
        )

-- | Create a temporary directory and pass it as a parameter to a 'Sh'
-- computation. The directory is nuked afterwards.
withTmpDir :: (FilePath -> Sh a) -> Sh a
withTmpDir :: forall a. ([Char] -> Sh a) -> Sh a
withTmpDir [Char] -> Sh a
act = do
  Text -> Sh ()
trace Text
"withTmpDir"
  [Char]
dir <- IO [Char] -> Sh [Char]
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getTemporaryDirectory
  ThreadId
tid <- IO ThreadId -> Sh ThreadId
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId
  ([Char]
pS, Handle
fhandle) <- IO ([Char], Handle) -> Sh ([Char], Handle)
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Char], Handle) -> Sh ([Char], Handle))
-> IO ([Char], Handle) -> Sh ([Char], Handle)
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ([Char], Handle)
openTempFile [Char]
dir ([Char]
"tmp" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum (ThreadId -> [Char]
forall a. Show a => a -> [Char]
show ThreadId
tid))
  let p :: [Char]
p = [Char] -> [Char]
pack [Char]
pS
  IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ HandleInitializer
hClose Handle
fhandle -- required on windows
  [Char] -> Sh ()
rm_f [Char]
p
  [Char] -> Sh ()
mkdir [Char]
p
  [Char] -> Sh a
act [Char]
p Sh a -> Sh () -> Sh a
forall a b. Sh a -> Sh b -> Sh a
`finally_sh` [Char] -> Sh ()
rm_rf [Char]
p

-- | Write a 'Text' to a file.
writefile :: FilePath -> Text -> Sh ()
writefile :: [Char] -> Text -> Sh ()
writefile [Char]
f' Text
bits = do
  [Char]
f <- (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"writefile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Char]
f'
  IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> Text -> IO ()
TIO.writeFile [Char]
f Text
bits)

writeBinary :: FilePath -> ByteString -> Sh ()
writeBinary :: [Char] -> ByteString -> Sh ()
writeBinary [Char]
f' ByteString
bytes = do
  [Char]
f <- (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"writeBinary " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Char]
f'
  IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> ByteString -> IO ()
BS.writeFile [Char]
f ByteString
bytes)

-- | Update a file, creating (a blank file) if it does not exist.
touchfile :: FilePath -> Sh ()
touchfile :: [Char] -> Sh ()
touchfile = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"touch " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Sh [Char]) -> ([Char] -> Sh ()) -> [Char] -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ([Char] -> Text -> Sh ()) -> Text -> [Char] -> Sh ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> Text -> Sh ()
appendfile Text
""

-- | Append a 'Text' to a file.
appendfile :: FilePath -> Text -> Sh ()
appendfile :: [Char] -> Text -> Sh ()
appendfile [Char]
f' Text
bits = do
  [Char]
f <- (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"appendfile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Char]
f'
  IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> Text -> IO ()
TIO.appendFile [Char]
f Text
bits)

readfile :: FilePath -> Sh Text
readfile :: [Char] -> Sh Text
readfile = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"readfile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Sh [Char]) -> ([Char] -> Sh Text) -> [Char] -> Sh Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
fp ->
  [Char] -> Sh ByteString
readBinary [Char]
fp Sh ByteString -> (ByteString -> Sh Text) -> Sh Text
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Text -> Sh Text
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Sh Text) -> (ByteString -> Text) -> ByteString -> Sh Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TE.lenientDecode

-- | Wraps 'BS.readFile'.
readBinary :: FilePath -> Sh ByteString
readBinary :: [Char] -> Sh ByteString
readBinary = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"readBinary " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
         ([Char] -> Sh [Char])
-> ([Char] -> Sh ByteString) -> [Char] -> Sh ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO ByteString -> Sh ByteString
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Sh ByteString)
-> ([Char] -> IO ByteString) -> [Char] -> Sh ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ByteString
BS.readFile

-- | Flipped 'hasExtension' for 'Text'.
hasExt :: Text -> FilePath -> Bool
hasExt :: Text -> [Char] -> Bool
hasExt Text
ext [Char]
fp = [Char] -> Text
T.pack ([Char] -> [Char]
FP.takeExtension [Char]
fp) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ext

-- | Run a 'Sh' computation and collect timing information.
--   The value returned is the amount of *real* time spent running the computation
--   in seconds, as measured by the system clock.
--   The precision is determined by the resolution of `getCurrentTime`.
time :: Sh a -> Sh (Double, a)
time :: forall a. Sh a -> Sh (Double, a)
time Sh a
what = Sh (Double, a) -> Sh (Double, a)
forall a. Sh a -> Sh a
sub (Sh (Double, a) -> Sh (Double, a))
-> Sh (Double, a) -> Sh (Double, a)
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sh ()
trace Text
"time"
  UTCTime
t <- IO UTCTime -> Sh UTCTime
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  a
res <- Sh a
what
  UTCTime
t' <- IO UTCTime -> Sh UTCTime
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  (Double, a) -> Sh (Double, a)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> Double) -> NominalDiffTime -> Double
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t' UTCTime
t, a
res)

-- | 'threadDelay' wrapper that uses seconds.
sleep :: Int -> Sh ()
sleep :: Int -> Sh ()
sleep = IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> (Int -> IO ()) -> Int -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
threadDelay (Int -> IO ()) -> (Int -> Int) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
*)

-- | Spawn an asynchronous action with a copy of the current state.
asyncSh :: Sh a -> Sh (Async a)
asyncSh :: forall a. Sh a -> Sh (Async a)
asyncSh Sh a
proc = do
  State
state <- Sh State
get
  IO (Async a) -> Sh (Async a)
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async a) -> Sh (Async a)) -> IO (Async a) -> Sh (Async a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Async a)
forall a. IO a -> IO (Async a)
async (IO a -> IO (Async a)) -> IO a -> IO (Async a)
forall a b. (a -> b) -> a -> b
$ Sh a -> IO a
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (State -> Sh ()
put State
state Sh () -> Sh a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
proc)

-- helper because absPath can throw exceptions
-- This helps give clear tracing messages
tracePath :: (FilePath -> Sh FilePath) -- ^ filepath conversion
          -> (Text -> Text) -- ^ tracing statement
          -> FilePath
          -> Sh FilePath -- ^ converted filepath
tracePath :: ([Char] -> Sh [Char]) -> (Text -> Text) -> [Char] -> Sh [Char]
tracePath [Char] -> Sh [Char]
convert Text -> Text
tracer [Char]
infp =
  ([Char] -> Sh [Char]
convert [Char]
infp Sh [Char] -> ([Char] -> Sh [Char]) -> Sh [Char]
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
fp -> [Char] -> Sh ()
traceIt [Char]
fp Sh () -> Sh [Char] -> Sh [Char]
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Sh [Char]
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
fp)
  Sh [Char] -> (SomeException -> Sh [Char]) -> Sh [Char]
forall a. Sh a -> (SomeException -> Sh a) -> Sh a
`catchany_sh` (\SomeException
e -> [Char] -> Sh ()
traceIt [Char]
infp Sh () -> Sh [Char] -> Sh [Char]
forall a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO [Char] -> Sh [Char]
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeException -> IO [Char]
forall e a. Exception e => e -> IO a
throwIO SomeException
e))
    where traceIt :: [Char] -> Sh ()
traceIt = Text -> Sh ()
trace (Text -> Sh ()) -> ([Char] -> Text) -> [Char] -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tracer (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
toTextIgnore

traceAbsPath :: (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath :: (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath = ([Char] -> Sh [Char]) -> (Text -> Text) -> [Char] -> Sh [Char]
tracePath [Char] -> Sh [Char]
absPath

traceCanonicPath :: (Text -> Text) -> FilePath -> Sh FilePath
traceCanonicPath :: (Text -> Text) -> [Char] -> Sh [Char]
traceCanonicPath = ([Char] -> Sh [Char]) -> (Text -> Text) -> [Char] -> Sh [Char]
tracePath [Char] -> Sh [Char]
canonic