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

-- | 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, FP.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.Monad ( when, unless, void, forM, filterM, liftM2 )
import Control.Monad.Trans ( MonadIO )
import Control.Monad.Reader (ask)
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706
import Prelude hiding ( readFile, FilePath, catch)
#else
import Prelude hiding ( readFile, FilePath)
#endif
import Data.Char ( isAlphaNum, isSpace, toLower )
import Data.Typeable
import Data.IORef
import Data.Sequence (Seq, (|>))
import Data.Foldable (toList)
import Data.Maybe
import System.IO ( hClose, stderr, stdout, openTempFile)
import System.IO.Error (isPermissionError, catchIOError, isEOFError, isIllegalOperation)
import System.Exit
import System.Environment
import Control.Applicative
import Control.Exception
import Control.Concurrent
import Control.Concurrent.Async (async, wait, Async)
import Data.Time.Clock( getCurrentTime, diffUTCTime  )

import qualified Data.Text.IO as TIO
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TE
import System.Process( CmdSpec(..), StdStream(CreatePipe, UseHandle), CreateProcess(..), createProcess, waitForProcess, terminateProcess, ProcessHandle, StdStream(..) )

import qualified Data.Text as T
import qualified Data.ByteString as BS
import Data.ByteString (ByteString)

import Data.Monoid (Monoid, mempty, mappend)
#if __GLASGOW_HASKELL__ < 704
infixr 5 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#else
import Data.Monoid ((<>))
#endif

import Filesystem.Path.CurrentOS hiding (concat, fromText, (</>), (<.>))
import Filesystem hiding (canonicalizePath)
import qualified Filesystem.Path.CurrentOS as FP

import System.Directory ( setPermissions, getPermissions, Permissions(..), getTemporaryDirectory, pathIsSymbolicLink )
import Data.Char (isDigit)

import Data.Tree(Tree(..))
import qualified Data.Set as S
import qualified Data.List as L

searchPathSeparator :: Char
#if defined(mingw32_HOST_OS)
searchPathSeparator = ';'
#else
searchPathSeparator :: Char
searchPathSeparator = Char
':'
#endif

{- GHC won't default to Text with this, even with extensions!
 - see: http://hackage.haskell.org/trac/ghc/ticket/6030
class CmdArgs a where
  toTextArgs :: a -> [Text]

instance CmdArgs Text       where toTextArgs t = [t]
instance CmdArgs FilePath   where toTextArgs t = [toTextIgnore t]
instance CmdArgs [Text]     where toTextArgs = id
instance CmdArgs [FilePath] where toTextArgs = map toTextIgnore

instance CmdArgs (Text, Text) where
  toTextArgs (t1,t2) = [t1, t2]
instance CmdArgs (FilePath, FilePath) where
  toTextArgs (fp1,fp2) = [toTextIgnore fp1, toTextIgnore fp2]
instance CmdArgs (Text, FilePath) where
  toTextArgs (t1, fp1) = [t1, toTextIgnore fp1]
instance CmdArgs (FilePath, Text) where
  toTextArgs (fp1,t1) = [toTextIgnore fp1, t1]

cmd :: (CmdArgs args) => FilePath -> args -> Sh Text
cmd fp args = run fp $ toTextArgs args
-}

-- | 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 toTextArg :: a -> Text
instance CmdArg Text     where toTextArg :: Text -> Text
toTextArg = Text -> Text
forall a. a -> a
id
instance CmdArg FilePath where toTextArg :: FilePath -> Text
toTextArg = FilePath -> Text
toTextIgnore
instance CmdArg String   where toTextArg :: String -> Text
toTextArg = String -> Text
T.pack

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

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

instance (s ~ Text, Show s) => ShellCmd (Sh s) where
    cmdAll :: FilePath -> [Text] -> Sh s
cmdAll = FilePath -> [Text] -> Sh s
FilePath -> [Text] -> Sh Text
run

-- note that Sh () actually doesn't work for its case (_<- cmd) when there is no type signature
instance ShellCmd (Sh ()) where
    cmdAll :: FilePath -> [Text] -> Sh ()
cmdAll = FilePath -> [Text] -> Sh ()
run_

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

instance (CmdArg arg, ShellCmd result) => ShellCmd ([arg] -> result) where
    cmdAll :: FilePath -> [Text] -> [arg] -> result
cmdAll FilePath
fp [Text]
acc [arg]
x = FilePath -> [Text] -> result
forall t. ShellCmd t => FilePath -> [Text] -> t
cmdAll FilePath
fp ([Text]
acc [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (arg -> Text) -> [arg] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map arg -> Text
forall a. CmdArg a => a -> Text
toTextArg [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 => FilePath -> result
cmd FilePath
fp = FilePath -> [Text] -> result
forall t. ShellCmd t => FilePath -> [Text] -> t
cmdAll FilePath
fp []

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

instance ToFilePath FilePath where toFilePath :: FilePath -> FilePath
toFilePath = FilePath -> FilePath
forall a. a -> a
id
instance ToFilePath Text     where toFilePath :: Text -> FilePath
toFilePath = Text -> FilePath
FP.fromText
instance ToFilePath String   where toFilePath :: String -> FilePath
toFilePath = Text -> FilePath
FP.fromText (Text -> FilePath) -> (String -> Text) -> String -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack


-- | uses System.FilePath.CurrentOS, but can automatically convert a Text
(</>) :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> FilePath
filepath1
x </> :: forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</> filepath2
y = filepath1 -> FilePath
forall a. ToFilePath a => a -> FilePath
toFilePath filepath1
x FilePath -> FilePath -> FilePath
FP.</> filepath2 -> FilePath
forall a. ToFilePath a => a -> FilePath
toFilePath filepath2
y

-- | uses System.FilePath.CurrentOS, but can automatically convert a Text
(<.>) :: (ToFilePath filepath) => filepath -> Text -> FilePath
filepath
x <.> :: forall filepath.
ToFilePath filepath =>
filepath -> Text -> FilePath
<.> Text
y = filepath -> FilePath
forall a. ToFilePath a => a -> FilePath
toFilePath filepath
x FilePath -> Text -> FilePath
FP.<.> Text
y


toTextWarn :: FilePath -> Sh Text
toTextWarn :: FilePath -> Sh Text
toTextWarn FilePath
efile = case FilePath -> Either Text Text
toText FilePath
efile of
    Left Text
f -> Text -> Sh ()
encodeError Text
f Sh () -> Sh Text -> Sh Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Sh Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
f
    Right Text
f -> Text -> Sh Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
f
  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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Text -> IO Text
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 (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 (m :: * -> *) a. Monad m => a -> m a
return a
acc
            Just Text
line -> Text -> IO ()
putWrite Text
line IO () -> IO a -> IO a
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 (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 (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 (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 use it combinator style
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 (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
-> FilePath
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommandNoEscape [StdHandle]
handles State
st FilePath
exe [Text]
args = IO (Handle, Handle, Handle, ProcessHandle)
-> Sh (Handle, Handle, Handle, ProcessHandle)
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
$
    String -> CmdSpec
ShellCommand (String -> CmdSpec) -> String -> CmdSpec
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
" " (FilePath -> Text
toTextIgnore FilePath
exe Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)

runCommand :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand :: [StdHandle]
-> State
-> FilePath
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand [StdHandle]
handles State
st FilePath
exe [Text]
args = FilePath -> Sh FilePath
findExe FilePath
exe Sh FilePath
-> (FilePath -> Sh (Handle, Handle, Handle, ProcessHandle))
-> Sh (Handle, Handle, Handle, ProcessHandle)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
fullExe ->
  IO (Handle, Handle, Handle, ProcessHandle)
-> Sh (Handle, Handle, Handle, ProcessHandle)
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
$
    String -> [String] -> CmdSpec
RawCommand (FilePath -> String
encodeString FilePath
fullExe) ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
args)
  where
    findExe :: FilePath -> Sh FilePath
    findExe :: FilePath -> Sh FilePath
findExe
#if defined(mingw32_HOST_OS) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 708)
      fp
#else
      FilePath
_fp
#endif
      = do
        Either String FilePath
mExe <- FilePath -> Sh (Either String FilePath)
whichEith FilePath
exe
        case Either String FilePath
mExe of
          Right FilePath
execFp -> FilePath -> Sh FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
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) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 708)
          Left _ -> return fp
#else
          Left String
err -> IO FilePath -> Sh FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Sh FilePath) -> IO FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ IOError -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO FilePath) -> IOError -> IO FilePath
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
err
#endif




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 String
cwd = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ FilePath -> String
encodeString (FilePath -> String) -> FilePath -> String
forall a b. (a -> b) -> a -> b
$ State -> FilePath
sDirectory State
st
        , env :: Maybe [(String, String)]
env = [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ([(String, String)] -> Maybe [(String, String)])
-> [(String, String)] -> Maybe [(String, String)]
forall a b. (a -> b) -> a -> b
$ State -> [(String, String)]
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
#if MIN_VERSION_process(1,1,0)
        , create_group :: Bool
create_group = Bool
False
#endif
#if MIN_VERSION_process(1,2,0)
        , delegate_ctlc :: Bool
delegate_ctlc = Bool
False
#endif
#if MIN_VERSION_process(1,3,0)
        , detach_console :: Bool
detach_console = Bool
False
        , create_new_console :: Bool
create_new_console = Bool
False
        , new_session :: Bool
new_session = Bool
False
#endif
#if MIN_VERSION_process(1,4,0)
        , 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
#endif
#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 (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 (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 (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 (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  = String -> a
forall a. HasCallStack => String -> a
error String
"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)    = String -> Maybe Handle
forall a. HasCallStack => String -> a
error String
"shelly process creation failure CreatePipe"
    toHandle (Just StdStream
Inherit)       = String -> Maybe Handle
forall a. HasCallStack => String -> a
error String
"cannot access an inherited pipe"
    toHandle Maybe StdStream
Nothing              = String -> Maybe Handle
forall a. HasCallStack => String -> a
error String
"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 (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 (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 (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 (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 (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 (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 :: FilePath -> Sh ()
cd = (Text -> Text) -> FilePath -> Sh FilePath
traceCanonicPath (Text
"cd " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> Sh FilePath)
-> (FilePath -> Sh ()) -> FilePath -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> FilePath -> Sh ()
cd'
  where
    cd' :: FilePath -> Sh ()
cd' FilePath
dir = do
        Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> Sh Bool
test_d FilePath
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 :: FilePath
sDirectory = FilePath
dir, sPathExecutables :: Maybe [(FilePath, Set FilePath)]
sPathExecutables = Maybe [(FilePath, Set FilePath)]
forall a. Maybe a
Nothing }
      where
        tdir :: Text
tdir = FilePath -> Text
toTextIgnore FilePath
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. FilePath -> Sh a -> Sh a
chdir FilePath
dir Sh a
action = do
  FilePath
d <- (State -> FilePath) -> Sh FilePath
forall a. (State -> a) -> Sh a
gets State -> FilePath
sDirectory
  FilePath -> Sh ()
cd FilePath
dir
  Sh a
action Sh a -> Sh () -> Sh a
forall a b. Sh a -> Sh b -> Sh a
`finally_sh` FilePath -> Sh ()
cd FilePath
d

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


-- | apply a String IO operations to a Text FilePath
{-
liftStringIO :: (String -> IO String) -> FilePath -> Sh FilePath
liftStringIO f = liftIO . f . unpack >=> return . pack

-- | @asString f = pack . f . unpack@
asString :: (String -> String) -> FilePath -> FilePath
asString f = pack . f . unpack
-}

pack :: String -> FilePath
pack :: String -> FilePath
pack = String -> FilePath
decodeString

-- | Move a file. The second path could be a directory, in which case the
-- original file is moved into that directory.
-- wraps system-fileio 'FileSystem.rename', which may not work across FS boundaries
mv :: FilePath -> FilePath -> Sh ()
mv :: FilePath -> FilePath -> Sh ()
mv FilePath
from' FilePath
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
<> FilePath -> Text
toTextIgnore FilePath
from' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
toTextIgnore FilePath
to'
  FilePath
from <- FilePath -> Sh FilePath
absPath FilePath
from'
  FilePath
to <- FilePath -> Sh FilePath
absPath FilePath
to'
  Bool
to_dir <- FilePath -> Sh Bool
test_d FilePath
to
  let to_loc :: FilePath
to_loc = if Bool -> Bool
not Bool
to_dir then FilePath
to else FilePath
to FilePath -> FilePath -> FilePath
FP.</> FilePath -> FilePath
filename FilePath
from
  IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
rename FilePath
from FilePath
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 -> String -> ReThrownException SomeException
forall e. e -> String -> ReThrownException e
ReThrownException SomeException
e (FilePath -> FilePath -> String
extraMsg FilePath
to_loc FilePath
from)
    )
  where
    extraMsg :: FilePath -> FilePath -> String
extraMsg FilePath
t FilePath
f = String
"during copy from: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FilePath -> String
encodeString FilePath
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FilePath -> String
encodeString FilePath
t

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

-- | Obtain the current (Sh) working directory.
pwd :: Sh FilePath
pwd :: Sh FilePath
pwd = (State -> FilePath) -> Sh FilePath
forall a. (State -> a) -> Sh a
gets State -> FilePath
sDirectory Sh FilePath -> Text -> Sh FilePath
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 (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 (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
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
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 (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 = String -> Sh a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Sh a) -> (Text -> String) -> Text -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

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

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

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

          unrollPath :: Tree FilePath -> Tree FilePath
          unrollPath :: Tree FilePath -> Tree FilePath
unrollPath (Node FilePath
v [Tree FilePath]
ts) = FilePath -> [Tree FilePath] -> Tree FilePath
unrollRoot FilePath
v ([Tree FilePath] -> Tree FilePath)
-> [Tree FilePath] -> Tree FilePath
forall a b. (a -> b) -> a -> b
$ (Tree FilePath -> Tree FilePath)
-> [Tree FilePath] -> [Tree FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Tree FilePath -> Tree FilePath
unrollPath [Tree FilePath]
ts
              where unrollRoot :: FilePath -> [Tree FilePath] -> Tree FilePath
unrollRoot FilePath
x = (([Tree FilePath] -> Tree FilePath)
 -> ([Tree FilePath] -> Tree FilePath)
 -> [Tree FilePath]
 -> Tree FilePath)
-> [[Tree FilePath] -> Tree FilePath]
-> [Tree FilePath]
-> Tree FilePath
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ([Tree FilePath] -> Tree FilePath)
-> ([Tree FilePath] -> Tree FilePath)
-> [Tree FilePath]
-> Tree FilePath
forall {m :: * -> *} {b} {c} {a}.
Monad m =>
(m b -> c) -> (a -> b) -> a -> c
phi ([[Tree FilePath] -> Tree FilePath]
 -> [Tree FilePath] -> Tree FilePath)
-> [[Tree FilePath] -> Tree FilePath]
-> [Tree FilePath]
-> Tree FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> [Tree FilePath] -> Tree FilePath)
-> [FilePath] -> [[Tree FilePath] -> Tree FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> [Tree FilePath] -> Tree FilePath
forall a. a -> [Tree a] -> Tree a
Node ([FilePath] -> [[Tree FilePath] -> Tree FilePath])
-> [FilePath] -> [[Tree FilePath] -> Tree FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitDirectories FilePath
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 (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 :: FilePath -> IO Bool
isExecutable FilePath
f = (Permissions -> Bool
executable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO Permissions
getPermissions (FilePath -> String
encodeString FilePath
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 (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 :: FilePath -> Sh (Maybe FilePath)
which FilePath
fp = (String -> Maybe FilePath)
-> (FilePath -> Maybe FilePath)
-> Either String FilePath
-> Maybe FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe FilePath -> String -> Maybe FilePath
forall a b. a -> b -> a
const Maybe FilePath
forall a. Maybe a
Nothing) FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Either String FilePath -> Maybe FilePath)
-> Sh (Either String FilePath) -> Sh (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Sh (Either String FilePath)
whichEith FilePath
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 :: FilePath -> Sh (Either String FilePath)
whichEith FilePath
originalFp = FilePath -> Sh (Either String FilePath)
whichFull
#if defined(mingw32_HOST_OS)
    $ case extension originalFp of
        Nothing -> originalFp <.> "exe"
        Just _ -> originalFp
#else
    FilePath
originalFp
#endif
  where
    whichFull :: FilePath -> Sh (Either String FilePath)
whichFull FilePath
fp = do
      (Text -> Sh ()
trace (Text -> Sh ()) -> (FilePath -> Text) -> FilePath -> 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) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
toTextIgnore) FilePath
fp Sh () -> Sh (Either String FilePath) -> Sh (Either String FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh (Either String FilePath)
whichUntraced
      where
        whichUntraced :: Sh (Either String FilePath)
whichUntraced | FilePath -> Bool
absolute FilePath
fp            = Sh (Either String FilePath)
checkFile
                      | [FilePath] -> Bool
forall {a}. (Eq a, IsString a) => [a] -> Bool
dotSlash [FilePath]
splitOnDirs   = Sh (Either String FilePath)
checkFile
                      | [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
splitOnDirs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Sh (Maybe FilePath)
lookupPath  Sh (Maybe FilePath)
-> (Maybe FilePath -> Sh (Either String FilePath))
-> Sh (Either String FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe FilePath -> Sh (Either String FilePath)
leftPathError
                      | Bool
otherwise              = Sh (Maybe FilePath)
lookupCache Sh (Maybe FilePath)
-> (Maybe FilePath -> Sh (Either String FilePath))
-> Sh (Either String FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe FilePath -> Sh (Either String FilePath)
leftPathError

        splitOnDirs :: [FilePath]
splitOnDirs = FilePath -> [FilePath]
splitDirectories FilePath
fp
        dotSlash :: [a] -> Bool
dotSlash (a
"./":[a]
_) = Bool
True
        dotSlash [a]
_ = Bool
False

        checkFile :: Sh (Either String FilePath)
        checkFile :: Sh (Either String FilePath)
checkFile = do
            Bool
exists <- IO Bool -> Sh Bool
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
$ FilePath -> IO Bool
isFile FilePath
fp
            Either String FilePath -> Sh (Either String FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String FilePath -> Sh (Either String FilePath))
-> Either String FilePath -> Sh (Either String FilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
exists then FilePath -> Either String FilePath
forall a b. b -> Either a b
Right FilePath
fp else
              String -> Either String FilePath
forall a b. a -> Either a b
Left (String -> Either String FilePath)
-> String -> Either String FilePath
forall a b. (a -> b) -> a -> b
$ String
"did not find file: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FilePath -> String
encodeString FilePath
fp

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

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

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

        lookupCache :: Sh (Maybe FilePath)
        lookupCache :: Sh (Maybe FilePath)
lookupCache = do
            [(FilePath, Set FilePath)]
pathExecutables <- Sh [(FilePath, Set FilePath)]
cachedPathExecutables
            Maybe FilePath -> Sh (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Sh (Maybe FilePath))
-> Maybe FilePath -> Sh (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ ((FilePath, Set FilePath) -> FilePath)
-> Maybe (FilePath, Set FilePath) -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> FilePath -> FilePath)
-> FilePath -> FilePath -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
(</>) FilePath
fp (FilePath -> FilePath)
-> ((FilePath, Set FilePath) -> FilePath)
-> (FilePath, Set FilePath)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Set FilePath) -> FilePath
forall a b. (a, b) -> a
fst) (Maybe (FilePath, Set FilePath) -> Maybe FilePath)
-> Maybe (FilePath, Set FilePath) -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$
                ((FilePath, Set FilePath) -> Bool)
-> [(FilePath, Set FilePath)] -> Maybe (FilePath, Set FilePath)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (FilePath -> Set FilePath -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member FilePath
fp (Set FilePath -> Bool)
-> ((FilePath, Set FilePath) -> Set FilePath)
-> (FilePath, Set FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Set FilePath) -> Set FilePath
forall a b. (a, b) -> b
snd) [(FilePath, Set FilePath)]
pathExecutables


        pathDirs :: Sh [FilePath]
pathDirs = (FilePath -> Sh FilePath) -> [FilePath] -> Sh [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> Sh FilePath
absPath ([FilePath] -> Sh [FilePath]) -> Sh [FilePath] -> Sh [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
FP.fromText ([Text] -> [FilePath]) -> (Text -> [Text]) -> Text -> [FilePath]
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 -> [FilePath]) -> Sh Text -> Sh [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> Sh Text
get_env_text Text
"PATH")

        cachedPathExecutables :: Sh [(FilePath, S.Set FilePath)]
        cachedPathExecutables :: Sh [(FilePath, Set FilePath)]
cachedPathExecutables = do
          Maybe [(FilePath, Set FilePath)]
mPathExecutables <- (State -> Maybe [(FilePath, Set FilePath)])
-> Sh (Maybe [(FilePath, Set FilePath)])
forall a. (State -> a) -> Sh a
gets State -> Maybe [(FilePath, Set FilePath)]
sPathExecutables
          case Maybe [(FilePath, Set FilePath)]
mPathExecutables of
              Just [(FilePath, Set FilePath)]
pExecutables -> [(FilePath, Set FilePath)] -> Sh [(FilePath, Set FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath, Set FilePath)]
pExecutables
              Maybe [(FilePath, Set FilePath)]
Nothing -> do
                [FilePath]
dirs <- Sh [FilePath]
pathDirs
                [Set FilePath]
executables <- [FilePath] -> (FilePath -> Sh (Set FilePath)) -> Sh [Set FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
dirs (\FilePath
dir -> do
                    [FilePath]
files <- (IO [FilePath] -> Sh [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Sh [FilePath])
-> (FilePath -> IO [FilePath]) -> FilePath -> Sh [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
listDirectory) FilePath
dir Sh [FilePath] -> (IOError -> Sh [FilePath]) -> Sh [FilePath]
forall e a. Exception e => Sh a -> (e -> Sh a) -> Sh a
`catch_sh` (\(IOError
_ :: IOError) -> [FilePath] -> Sh [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
                    [FilePath]
exes <- ([(FilePath, FilePath)] -> [FilePath])
-> Sh [(FilePath, FilePath)] -> Sh [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) (Sh [(FilePath, FilePath)] -> Sh [FilePath])
-> Sh [(FilePath, FilePath)] -> Sh [FilePath]
forall a b. (a -> b) -> a -> b
$ IO [(FilePath, FilePath)] -> Sh [(FilePath, FilePath)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(FilePath, FilePath)] -> Sh [(FilePath, FilePath)])
-> IO [(FilePath, FilePath)] -> Sh [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> IO Bool)
-> [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
isExecutable (FilePath -> IO Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst) ([(FilePath, FilePath)] -> IO [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$
                      (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
f -> (FilePath
f, FilePath -> FilePath
filename FilePath
f)) [FilePath]
files
                    Set FilePath -> Sh (Set FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set FilePath -> Sh (Set FilePath))
-> Set FilePath -> Sh (Set FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
S.fromList [FilePath]
exes
                  )
                let cachedExecutables :: [(FilePath, Set FilePath)]
cachedExecutables = [FilePath] -> [Set FilePath] -> [(FilePath, Set FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
dirs [Set FilePath]
executables
                (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
x -> State
x { sPathExecutables :: Maybe [(FilePath, Set FilePath)]
sPathExecutables = [(FilePath, Set FilePath)] -> Maybe [(FilePath, Set FilePath)]
forall a. a -> Maybe a
Just [(FilePath, Set FilePath)]
cachedExecutables }
                [(FilePath, Set FilePath)] -> Sh [(FilePath, Set FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, Set FilePath)] -> Sh [(FilePath, Set FilePath)])
-> [(FilePath, Set FilePath)] -> Sh [(FilePath, Set FilePath)]
forall a b. (a -> b) -> a -> b
$ [(FilePath, Set FilePath)]
cachedExecutables


-- | 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 (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 (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 (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 :: FilePath -> Sh Bool
test_e = FilePath -> Sh FilePath
absPath (FilePath -> Sh FilePath)
-> (FilePath -> Sh Bool) -> FilePath -> Sh Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \FilePath
f ->
  IO Bool -> Sh Bool
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 <- FilePath -> IO Bool
isFile FilePath
f
    if Bool
file then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else FilePath -> IO Bool
isDirectory FilePath
f

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

-- | Test that a file is in the PATH and also executable
test_px :: FilePath -> Sh Bool
test_px :: FilePath -> Sh Bool
test_px FilePath
exe = do
  Maybe FilePath
mFull <- FilePath -> Sh (Maybe FilePath)
which FilePath
exe
  case Maybe FilePath
mFull of
    Maybe FilePath
Nothing -> Bool -> Sh Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just FilePath
full -> IO Bool -> Sh Bool
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
$ FilePath -> IO Bool
isExecutable FilePath
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 'removeTree'
rm_rf :: FilePath -> Sh ()
rm_rf :: FilePath -> Sh ()
rm_rf FilePath
infp = do
  FilePath
f <- (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath (Text
"rm -rf " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) FilePath
infp
  Bool
isDir <- (FilePath -> Sh Bool
test_d FilePath
f)
  if Bool -> Bool
not Bool
isDir then Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> Sh Bool
test_f FilePath
f) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Sh ()
rm_f FilePath
f
    else
      (IO () -> Sh ()
forall a. IO a -> Sh ()
liftIO_ (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeTree FilePath
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
          FilePath -> Sh [FilePath]
find FilePath
f Sh [FilePath] -> ([FilePath] -> Sh ()) -> Sh ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Sh ()) -> [FilePath] -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FilePath
file -> IO () -> Sh ()
forall a. IO a -> Sh ()
liftIO_ (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall {m :: * -> *}. MonadIO m => String -> m ()
fixPermissions (FilePath -> String
encodeString FilePath
file) IO () -> (SomeException -> IO ()) -> IO ()
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` \SomeException
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeTree FilePath
f
        )
  where fixPermissions :: String -> m ()
fixPermissions String
file =
          do Permissions
permissions <- IO Permissions -> m Permissions
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
$ String -> IO Permissions
getPermissions String
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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Permissions -> IO ()
setPermissions String
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 :: FilePath -> Sh ()
rm_f = (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> Sh FilePath)
-> (FilePath -> Sh ()) -> FilePath -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \FilePath
f ->
  Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> Sh Bool
test_e FilePath
f) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
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 :: FilePath -> Sh ()
rm = (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath (Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> Sh FilePath)
-> (FilePath -> Sh ()) -> FilePath -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  -- TODO: better error message for removeFile (give filename)
  IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> (FilePath -> IO ()) -> FilePath -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> 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 :: [(String, String)]
sEnvironment = [(String, String)] -> [(String, String)]
wibble ([(String, String)] -> [(String, String)])
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ State -> [(String, String)]
sEnvironment State
x }
  where
    normK :: Text
normK = Text -> Text
normalizeEnvVarNameText Text
k
    (String
kStr, String
vStr) = (Text -> String
T.unpack Text
normK, Text -> String
T.unpack Text
v)
    wibble :: [(String, String)] -> [(String, String)]
wibble [(String, String)]
environment = (String
kStr, String
vStr) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
kStr) (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
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 [(FilePath, Set FilePath)]
sPathExecutables = Maybe [(FilePath, Set FilePath)]
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 :: FilePath -> Sh ()
appendToPath = (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath (Text
"appendToPath: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> Sh FilePath)
-> (FilePath -> Sh ()) -> FilePath -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \FilePath
filepath -> do
  Text
tp <- FilePath -> Sh Text
toTextWarn FilePath
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 :: FilePath -> Sh ()
prependToPath = (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath (Text
"prependToPath: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> Sh FilePath)
-> (FilePath -> Sh ()) -> FilePath -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \FilePath
filepath -> do
  Text
tp <- FilePath -> Sh Text
toTextWarn FilePath
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 [(String, String)]
get_environment = (State -> [(String, String)]) -> Sh [(String, String)]
forall a. (State -> a) -> Sh a
gets State -> [(String, String)]
sEnvironment
{-# DEPRECATED get_environment "use get_env_all" #-}

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

-- On Windows, normalize all environment variable names (to lowercase)
-- to account for case insensitivity.
#if defined(mingw32_HOST_OS)

normalizeEnvVarNameText :: Text -> Text
normalizeEnvVarNameText = T.toLower

normalizeEnvVarNameString :: String -> String
normalizeEnvVarNameString = fmap toLower

-- On other systems, keep the variable names as-is.
#else

normalizeEnvVarNameText :: Text -> Text
normalizeEnvVarNameText :: Text -> Text
normalizeEnvVarNameText = Text -> Text
forall a. a -> a
id

normalizeEnvVarNameString :: String -> String
normalizeEnvVarNameString :: String -> String
normalizeEnvVarNameString = String -> String
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 (m :: * -> *) a. Monad m => a -> m a
return
          (Maybe Text -> Sh (Maybe Text))
-> ([(String, String)] -> Maybe Text)
-> [(String, String)]
-> Sh (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack
          (Maybe String -> Maybe Text)
-> ([(String, String)] -> Maybe String)
-> [(String, String)]
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> String
T.unpack Text
normK)
          ([(String, String)] -> Sh (Maybe Text))
-> Sh [(String, String)] -> Sh (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (State -> [(String, String)]) -> Sh [(String, String)]
forall a. (State -> a) -> Sh a
gets State -> [(String, String)]
sEnvironment
  Maybe Text -> Sh (Maybe Text)
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

-- | deprecated
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 [(String, String)]
getNormalizedEnvironment =
#if defined(mingw32_HOST_OS)
  -- On Windows, normalize all environment variable names (to lowercase)
  -- to account for case insensitivity.
  fmap (\(a, b) -> (normalizeEnvVarNameString a, b)) <$> getEnvironment
#else
  -- On other systems, keep the environment as-is.
  IO [(String, String)]
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
  [(String, String)]
environment <- IO [(String, String)] -> m [(String, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getNormalizedEnvironment
  FilePath
dir <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getWorkingDirectory
  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 (m :: * -> *) a. Monad m => a -> m a
return ())
                   , sCommandEscaping :: Bool
sCommandEscaping = Bool
True
                   , sEnvironment :: [(String, String)]
sEnvironment = [(String, String)]
environment
                   , sTracing :: Bool
sTracing = Bool
True
                   , sTrace :: Text
sTrace = Text
T.empty
                   , sDirectory :: FilePath
sDirectory = FilePath
dir
                   , sPathExecutables :: Maybe [(FilePath, Set FilePath)]
sPathExecutables = Maybe [(FilePath, Set FilePath)]
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 (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 (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 (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 (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 String) -> Sh String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State -> Sh String
errorMsg Sh String -> (String -> Sh a) -> Sh a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> (String -> IO a) -> String -> 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)
-> (String -> ReThrownException exception) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. exception -> String -> ReThrownException exception
forall e. e -> String -> ReThrownException e
ReThrownException exception
ex

    errorMsg :: State -> Sh String
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 String
ranCommands else do
          FilePath
d <- Sh FilePath
pwd
          FilePath
sf <- Sh FilePath
shellyFile
          let logFile :: FilePath
logFile = FilePath
dFilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</>FilePath
shelly_dirFilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</>FilePath
sf
          (FilePath -> Text -> Sh ()
writefile FilePath
logFile Text
trc Sh () -> Sh String -> Sh String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Sh String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"log of commands saved to: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FilePath -> String
encodeString FilePath
logFile))
            Sh String -> (SomeException -> Sh String) -> Sh String
forall a. Sh a -> (SomeException -> Sh a) -> Sh a
`catchany_sh` (\SomeException
_ -> Sh String
ranCommands)

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

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

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

-- from safe package
readDef :: Read a => a -> String -> a
readDef :: forall a. Read a => a -> String -> a
readDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> (String -> Maybe a) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMay
  where
    readMay :: Read a => String -> Maybe a
    readMay :: forall a. Read a => String -> Maybe a
readMay String
s = case [a
x | (a
x,String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s, (String
"",String
"") <- ReadS String
lex String
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 -> String
show (RunFailed FilePath
exe [Text]
args Int
code Text
errs) =
    let codeMsg :: String
codeMsg = case Int
code of
          Int
127 -> String
". exit code 127 usually means the command does not exist (in the PATH)"
          Int
_ -> String
""
    in String
"error running: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (FilePath -> [Text] -> Text
show_command FilePath
exe [Text]
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++
         String
"\nexit status: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
codeMsg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nstderr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
errs

instance Exception RunFailed

show_command :: FilePath -> [Text] -> Text
show_command :: FilePath -> [Text] -> Text
show_command FilePath
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
quote (FilePath -> Text
toTextIgnore FilePath
exe Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)
  where
    quote :: Text -> Text
quote Text
t | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') Text
t = Text
t
    quote Text
t | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpace Text
t = Char -> Text -> Text
surround Char
'\'' Text
t
    quote Text
t | Bool
otherwise = Text
t

-- 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
$ 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 :: FilePath -> [Text] -> Text
quoteCommand FilePath
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 (FilePath -> Text
toTextIgnore FilePath
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 -> [(FilePath, [Text])] -> Sh ()
sshPairs_ Text
_ [] = () -> Sh ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sshPairs_ Text
server [(FilePath, [Text])]
cmds = (FilePath -> [Text] -> Sh ())
-> Text -> [(FilePath, [Text])] -> Sh ()
forall a.
(FilePath -> [Text] -> Sh a)
-> Text -> [(FilePath, [Text])] -> Sh a
sshPairs' FilePath -> [Text] -> Sh ()
run_ Text
server [(FilePath, [Text])]
cmds

-- | same as 'sshPairsP', but returns ()

sshPairsPar_ :: Text -> [(FilePath, [Text])] -> Sh ()
sshPairsPar_ :: Text -> [(FilePath, [Text])] -> Sh ()
sshPairsPar_ Text
_ [] = () -> Sh ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sshPairsPar_ Text
server [(FilePath, [Text])]
cmds = (FilePath -> [Text] -> Sh ())
-> Text -> [(FilePath, [Text])] -> Sh ()
forall a.
(FilePath -> [Text] -> Sh a)
-> Text -> [(FilePath, [Text])] -> Sh a
sshPairsPar' FilePath -> [Text] -> Sh ()
run_ Text
server [(FilePath, [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 -> [(FilePath, [Text])] -> Sh Text
sshPairs Text
_ [] = Text -> Sh Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairs Text
server [(FilePath, [Text])]
cmds = (FilePath -> [Text] -> Sh Text)
-> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh Text
forall a.
(FilePath -> [Text] -> Sh a)
-> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' FilePath -> [Text] -> Sh Text
run Text
server [] [(FilePath, [Text])]
cmds SshMode
SeqSsh

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

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

sshPairs' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
sshPairs' :: forall a.
(FilePath -> [Text] -> Sh a)
-> Text -> [(FilePath, [Text])] -> Sh a
sshPairs' FilePath -> [Text] -> Sh a
run' Text
server [(FilePath, [Text])]
actions = (FilePath -> [Text] -> Sh a)
-> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh a
forall a.
(FilePath -> [Text] -> Sh a)
-> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' FilePath -> [Text] -> Sh a
run' Text
server [] [(FilePath, [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] -> [(FilePath, [Text])] -> Sh Text
sshPairsWithOptions Text
_ [Text]
_ [] = Text -> Sh Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairsWithOptions Text
server [Text]
sshargs [(FilePath, [Text])]
cmds = (FilePath -> [Text] -> Sh Text)
-> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh Text
forall a.
(FilePath -> [Text] -> Sh a)
-> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' FilePath -> [Text] -> Sh Text
run Text
server [Text]
sshargs [(FilePath, [Text])]
cmds SshMode
SeqSsh

sshPairsWithOptions' :: (FilePath -> [Text] -> Sh a) -> Text -> [Text] -> [(FilePath, [Text])] -> SshMode  -> Sh a
sshPairsWithOptions' :: forall a.
(FilePath -> [Text] -> Sh a)
-> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' FilePath -> [Text] -> Sh a
run' Text
server [Text]
sshargs [(FilePath, [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
    FilePath -> [Text] -> Sh a
run' FilePath
"ssh" ([Text
server] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sshargs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [[(FilePath, [Text])] -> SshMode -> Text
sshCommandText [(FilePath, [Text])]
actions SshMode
mode])

sshCommandText :: [(FilePath, [Text])] -> SshMode -> Text
sshCommandText :: [(FilePath, [Text])] -> SshMode -> Text
sshCommandText [(FilePath, [Text])]
actions SshMode
mode =
    Text -> Text
quoteOne ((Text -> Text -> Text) -> [Text] -> Text
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Text -> Text -> Text
joiner (((FilePath, [Text]) -> Text) -> [(FilePath, [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> [Text] -> Text) -> (FilePath, [Text]) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> [Text] -> Text
quoteCommand) [(FilePath, [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 -> String -> String
[QuietExit] -> String -> String
QuietExit -> String
(Int -> QuietExit -> String -> String)
-> (QuietExit -> String)
-> ([QuietExit] -> String -> String)
-> Show QuietExit
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [QuietExit] -> String -> String
$cshowList :: [QuietExit] -> String -> String
show :: QuietExit -> String
$cshow :: QuietExit -> String
showsPrec :: Int -> QuietExit -> String -> String
$cshowsPrec :: Int -> QuietExit -> String -> String
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 -> String
show (ReThrownException e
ex String
msg) = String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
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'
--
-- 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 :: FilePath -> [Text] -> Sh Text
run FilePath
fp [Text]
args = Text -> Sh Text
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) -> FilePath -> [Text] -> Sh (Seq Text)
forall a. a -> FoldCallback a -> FilePath -> [Text] -> Sh a
runFoldLines Seq Text
forall a. Monoid a => a
mempty FoldCallback (Seq Text)
forall a. Seq a -> a -> Seq a
(|>) FilePath
fp [Text]
args

-- | Like 'run', but it invokes the user-requested program with _bash_.
bash :: FilePath -> [Text] -> Sh Text
bash :: FilePath -> [Text] -> Sh Text
bash FilePath
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
$ FilePath -> [Text] -> Sh Text
run FilePath
"bash" ([Text] -> Sh Text) -> [Text] -> Sh Text
forall a b. (a -> b) -> a -> b
$ FilePath -> [Text] -> [Text]
bashArgs FilePath
fp [Text]
args

bash_ :: FilePath -> [Text] -> Sh ()
bash_ :: FilePath -> [Text] -> Sh ()
bash_ FilePath
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
$ FilePath -> [Text] -> Sh ()
run_ FilePath
"bash" ([Text] -> Sh ()) -> [Text] -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [Text] -> [Text]
bashArgs FilePath
fp [Text]
args

bashArgs :: FilePath -> [Text] -> [Text]
bashArgs :: FilePath -> [Text] -> [Text]
bashArgs FilePath
fp [Text]
args = [Text
"-c", Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
sanitise (FilePath -> Text
toTextIgnore FilePath
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 = 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.
(FilePath -> [Text] -> Sh a) -> FilePath -> [Text] -> Sh a
bashPipeFail FilePath -> [Text] -> Sh a
runner FilePath
fp [Text]
args = FilePath -> [Text] -> Sh a
runner FilePath
"set -o pipefail;" (FilePath -> Text
toTextIgnore FilePath
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 :: FilePath -> [Text] -> [Text] -> Sh Text
command FilePath
com [Text]
args [Text]
more_args = FilePath -> [Text] -> Sh Text
run FilePath
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_ :: FilePath -> [Text] -> [Text] -> Sh ()
command_ FilePath
com [Text]
args [Text]
more_args = FilePath -> [Text] -> Sh ()
run_ FilePath
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 :: FilePath -> [Text] -> Text -> [Text] -> Sh Text
command1 FilePath
com [Text]
args Text
one_arg [Text]
more_args = FilePath -> [Text] -> Sh Text
run FilePath
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_ :: FilePath -> [Text] -> Text -> [Text] -> Sh ()
command1_ FilePath
com [Text]
args Text
one_arg [Text]
more_args = FilePath -> [Text] -> Sh ()
run_ FilePath
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
-- stdout will be read and discarded line-by-line
run_ :: FilePath -> [Text] -> Sh ()
run_ :: FilePath -> [Text] -> Sh ()
run_ FilePath
exe [Text]
args = do
    State
state <- Sh State
get
    if State -> Bool
sPrintStdout State
state
      then Sh ()
runWithColor_
      else () -> FoldCallback () -> FilePath -> [Text] -> Sh ()
forall a. a -> FoldCallback a -> FilePath -> [Text] -> Sh a
runFoldLines () (\()
_ Text
_ -> ()) FilePath
exe [Text]
args
  where
    -- same a runFoldLines except Inherit Stdout
    -- That allows color to show up
    runWithColor_ :: Sh ()
runWithColor_ =
        FilePath
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh ())
-> Sh ()
forall a.
FilePath
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles FilePath
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 (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 (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 (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 (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. FilePath -> [Text] -> (Handle -> Sh a) -> Sh a
runHandle FilePath
exe [Text]
args Handle -> Sh a
withHandle = FilePath
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
forall a.
FilePath
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles FilePath
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 (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 (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 (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 (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.
FilePath
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles FilePath
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 = FilePath -> [Text] -> Text
show_command FilePath
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
-> FilePath
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
doRun = if State -> Bool
sCommandEscaping State
state then [StdHandle]
-> State
-> FilePath
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand else [StdHandle]
-> State
-> FilePath
-> [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
-> FilePath
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
doRun [StdHandle]
reusedHandles State
state FilePath
exe [Text]
args)
      (\(Handle
_,Handle
_,Handle
_,ProcessHandle
procH) -> (IO () -> Sh ()
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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ())

          (ExitCode, Int) -> IO (ExitCode, Int)
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 (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
$ FilePath -> [Text] -> Int -> Text -> RunFailed
RunFailed FilePath
exe [Text]
args Int
n (State -> Text
sStderr State
newState)
          (Bool, ExitCode)
_                      -> a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
      )


-- | used by 'run'. fold over stdout line-by-line as it is read to avoid keeping it in memory
-- stderr is still being placed in memory under the assumption it is always relatively small
runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> Sh a
runFoldLines :: forall a. a -> FoldCallback a -> FilePath -> [Text] -> Sh a
runFoldLines a
start FoldCallback a
cb FilePath
exe [Text]
args =
  FilePath
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
forall a.
FilePath
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles FilePath
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 (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 (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 (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 (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 (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 :: FilePath -> FilePath -> Sh ()
cp_r FilePath
from' FilePath
to' = do
    FilePath
from <- FilePath -> Sh FilePath
absPath FilePath
from'
    Bool
fromIsDir <- (FilePath -> Sh Bool
test_d FilePath
from)
    if Bool -> Bool
not Bool
fromIsDir then Bool -> FilePath -> FilePath -> Sh ()
cp_should_follow_symlinks Bool
False FilePath
from' FilePath
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
<> FilePath -> Text
toTextIgnore FilePath
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
toTextIgnore FilePath
to'
       FilePath
to <- FilePath -> Sh FilePath
absPath FilePath
to'
       Bool
toIsDir <- FilePath -> Sh Bool
test_d FilePath
to

       Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
from FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
to) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ IO () -> Sh ()
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
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"cp_r: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
         FilePath -> Text
toTextIgnore FilePath
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
toTextIgnore FilePath
to Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are identical"

       FilePath
finalTo <- if Bool -> Bool
not Bool
toIsDir then FilePath -> Sh ()
mkdir FilePath
to Sh () -> Sh FilePath -> Sh FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Sh FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
to else do
                   let d :: FilePath
d = FilePath
to FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</> FilePath -> FilePath
dirname (FilePath -> FilePath
addTrailingSlash FilePath
from)
                   FilePath -> Sh ()
mkdir_p FilePath
d Sh () -> Sh FilePath -> Sh FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Sh FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
d

       FilePath -> Sh [FilePath]
ls FilePath
from Sh [FilePath] -> ([FilePath] -> Sh ()) -> Sh ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Sh ()) -> [FilePath] -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FilePath
item -> FilePath -> FilePath -> Sh ()
cp_r (FilePath
from FilePath -> FilePath -> FilePath
FP.</> FilePath -> FilePath
filename FilePath
item) (FilePath
finalTo FilePath -> FilePath -> FilePath
FP.</> FilePath -> FilePath
filename FilePath
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 :: FilePath -> FilePath -> Sh ()
cp = Bool -> FilePath -> FilePath -> Sh ()
cp_should_follow_symlinks Bool
True

cp_should_follow_symlinks :: Bool -> FilePath -> FilePath -> Sh ()
cp_should_follow_symlinks :: Bool -> FilePath -> FilePath -> Sh ()
cp_should_follow_symlinks Bool
shouldFollowSymlinks FilePath
from' FilePath
to' = do
  FilePath
from <- FilePath -> Sh FilePath
absPath FilePath
from'
  FilePath
to <- FilePath -> Sh FilePath
absPath FilePath
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
<> FilePath -> Text
toTextIgnore FilePath
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
toTextIgnore FilePath
to
  Bool
to_dir <- FilePath -> Sh Bool
test_d FilePath
to
  let to_loc :: FilePath
to_loc = if Bool
to_dir then FilePath
to FilePath -> FilePath -> FilePath
FP.</> FilePath -> FilePath
filename FilePath
from else FilePath
to
  if Bool
shouldFollowSymlinks then FilePath -> FilePath -> Sh ()
forall {m :: * -> *}. MonadIO m => FilePath -> FilePath -> m ()
copyNormal FilePath
from FilePath
to_loc else do
    Bool
isSymlink <- IO Bool -> Sh Bool
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
$ String -> IO Bool
pathIsSymbolicLink (FilePath -> String
encodeString FilePath
from)
    if Bool -> Bool
not Bool
isSymlink then FilePath -> FilePath -> Sh ()
forall {m :: * -> *}. MonadIO m => FilePath -> FilePath -> m ()
copyNormal FilePath
from FilePath
to_loc else do
      String
target <- IO String -> Sh String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Sh String) -> IO String -> Sh String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getSymbolicLinkTarget (FilePath -> String
encodeString FilePath
from)
      IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
createFileLink String
target (FilePath -> String
encodeString FilePath
to_loc)
  where
    extraMsg :: FilePath -> FilePath -> String
extraMsg FilePath
t FilePath
f = String
"during copy from: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FilePath -> String
encodeString FilePath
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FilePath -> String
encodeString FilePath
t
    copyNormal :: FilePath -> FilePath -> m ()
copyNormal FilePath
from FilePath
to = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
from FilePath
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 -> String -> ReThrownException SomeException
forall e. e -> String -> ReThrownException e
ReThrownException SomeException
e (FilePath -> FilePath -> String
extraMsg FilePath
to FilePath
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. (FilePath -> Sh a) -> Sh a
withTmpDir FilePath -> Sh a
act = do
  Text -> Sh ()
trace Text
"withTmpDir"
  String
dir <- IO String -> Sh String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getTemporaryDirectory
  ThreadId
tid <- IO ThreadId -> Sh ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId
  (String
pS, Handle
fhandle) <- IO (String, Handle) -> Sh (String, Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (String, Handle) -> Sh (String, Handle))
-> IO (String, Handle) -> Sh (String, Handle)
forall a b. (a -> b) -> a -> b
$ String -> String -> IO (String, Handle)
openTempFile String
dir (String
"tmp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum (ThreadId -> String
forall a. Show a => a -> String
show ThreadId
tid))
  let p :: FilePath
p = String -> FilePath
pack String
pS
  IO () -> Sh ()
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
  FilePath -> Sh ()
rm_f FilePath
p
  FilePath -> Sh ()
mkdir FilePath
p
  FilePath -> Sh a
act FilePath
p Sh a -> Sh () -> Sh a
forall a b. Sh a -> Sh b -> Sh a
`finally_sh` FilePath -> Sh ()
rm_rf FilePath
p

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

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

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

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

readfile :: FilePath -> Sh Text
readfile :: FilePath -> Sh Text
readfile = (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath (Text
"readfile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> Sh FilePath)
-> (FilePath -> Sh Text) -> FilePath -> Sh Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \FilePath
fp ->
  FilePath -> Sh ByteString
readBinary FilePath
fp Sh ByteString -> (ByteString -> Sh Text) -> Sh Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Text -> Sh Text
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 ByteSting readFile
readBinary :: FilePath -> Sh ByteString
readBinary :: FilePath -> Sh ByteString
readBinary = (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath (Text
"readBinary " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
         (FilePath -> Sh FilePath)
-> (FilePath -> Sh ByteString) -> FilePath -> Sh ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO ByteString -> Sh ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Sh ByteString)
-> (FilePath -> IO ByteString) -> FilePath -> Sh ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
BS.readFile (String -> IO ByteString)
-> (FilePath -> String) -> FilePath -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> String
encodeString

-- | flipped hasExtension for Text
hasExt :: Text -> FilePath -> Bool
hasExt :: Text -> FilePath -> Bool
hasExt = (FilePath -> Text -> Bool) -> Text -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> Text -> Bool
hasExtension

-- | 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  a
res <- Sh a
what
  UTCTime
t' <- IO UTCTime -> Sh UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  (Double, a) -> Sh (Double, 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 (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 (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 (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 :: (FilePath -> Sh FilePath)
-> (Text -> Text) -> FilePath -> Sh FilePath
tracePath FilePath -> Sh FilePath
convert Text -> Text
tracer FilePath
infp =
  (FilePath -> Sh FilePath
convert FilePath
infp Sh FilePath -> (FilePath -> Sh FilePath) -> Sh FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
fp -> FilePath -> Sh ()
traceIt FilePath
fp Sh () -> Sh FilePath -> Sh FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Sh FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp)
  Sh FilePath -> (SomeException -> Sh FilePath) -> Sh FilePath
forall a. Sh a -> (SomeException -> Sh a) -> Sh a
`catchany_sh` (\SomeException
e -> FilePath -> Sh ()
traceIt FilePath
infp Sh () -> Sh FilePath -> Sh FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO FilePath -> Sh FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeException -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO SomeException
e))
    where traceIt :: FilePath -> Sh ()
traceIt = Text -> Sh ()
trace (Text -> Sh ()) -> (FilePath -> Text) -> FilePath -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tracer (Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
toTextIgnore

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

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