{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Shelly
(
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
, run, run_, runFoldLines, cmd, FoldCallback
, bash, bash_, bashPipeFail
, (-|-), lastStderr, setStdin, lastExitCode
, command, command_, command1, command1_
, sshPairs,sshPairsPar, sshPairs_,sshPairsPar_, sshPairsWithOptions
, sshCommandText, SshMode(..)
, ShellCmd(..), CmdArg (..)
, runHandle, runHandles, transferLinesAndCombine, transferFoldHandleLines
, StdHandle(..), StdStream(..)
, HandleInitializer, StdInit(..), initOutputHandles, initAllHandles
, setenv, get_env, get_env_text, getenv, get_env_def, get_env_all, get_environment, appendToPath, prependToPath
, cd, chdir, chdir_p, pwd
, echo, echo_n, echo_err, echo_n_err, inspect, inspect_err
, tag, trace, show_command
, ls, lsT, test_e, test_f, test_d, test_s, test_px, which
, absPath, (</>), (<.>), canonic, canonicalize, relPath, relativeTo, path
, hasExt
, mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree
, readfile, readBinary, writefile, writeBinary, appendfile, touchfile, withTmpDir
, exit, errorExit, quietExit, terror
, bracket_sh, catchany, catch_sh, handle_sh, handleany_sh, finally_sh, ShellyHandler(..), catches_sh, catchany_sh
, ReThrownException(..)
, RunFailed(..)
, toTextIgnore, toTextWarn, fromText
, whenM, unlessM, time, sleep
, liftIO, when, unless, FilePath, (<$>)
, get, put
, find, findWhen, findFold, findDirFilter, findDirFilterWhen, findFoldDirFilter
, followSymlink
) where
import Shelly.Base
import Shelly.Directory
import Shelly.Find
import Control.Applicative
import Control.Concurrent
import Control.Concurrent.Async (async, wait, Async)
import Control.Exception
import Control.Monad ( when, unless, void, forM, filterM, liftM2 )
import Control.Monad.Trans ( MonadIO )
import Control.Monad.Reader (ask)
import Data.ByteString ( ByteString )
import Data.Char ( isAlphaNum, isDigit, isSpace )
#if defined(mingw32_HOST_OS)
import Data.Char ( toLower )
#endif
import Data.Foldable ( toList )
import Data.IORef
import Data.Maybe
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ( (<>) )
#endif
import Data.Sequence ( Seq, (|>) )
import Data.Set ( Set )
import Data.Time.Clock ( getCurrentTime, diffUTCTime )
import Data.Tree ( Tree(..) )
import Data.Typeable
import qualified Data.ByteString as BS
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TE
import System.Directory
( setPermissions, getPermissions, Permissions(..), getTemporaryDirectory, pathIsSymbolicLink
, copyFile, removeFile, doesFileExist, doesDirectoryExist, listDirectory
, renameFile, renameDirectory, removeDirectoryRecursive, createDirectoryIfMissing
, getCurrentDirectory
)
import System.Environment
import System.Exit
import System.FilePath hiding ((</>), (<.>))
import qualified System.FilePath as FP
import System.IO ( Handle, hClose, stderr, stdout, openTempFile)
import System.IO.Error (isPermissionError, catchIOError, isEOFError, isIllegalOperation)
import System.Process
( CmdSpec(..), StdStream(CreatePipe, UseHandle), CreateProcess(..)
, createProcess, waitForProcess, terminateProcess
, ProcessHandle, StdStream(..)
)
class CmdArg a where toTextArg :: a -> Text
instance CmdArg Text where toTextArg :: Text -> Text
toTextArg = Text -> Text
forall a. a -> a
id
instance CmdArg String where toTextArg :: String -> Text
toTextArg = String -> Text
T.pack
class ShellCmd t where
cmdAll :: FilePath -> [Text] -> t
instance ShellCmd (Sh Text) where
cmdAll :: String -> [Text] -> Sh Text
cmdAll = String -> [Text] -> Sh Text
run
instance (s ~ Text, Show s) => ShellCmd (Sh s) where
cmdAll :: String -> [Text] -> Sh s
cmdAll = String -> [Text] -> Sh s
String -> [Text] -> Sh Text
run
instance ShellCmd (Sh ()) where
cmdAll :: String -> [Text] -> Sh ()
cmdAll = String -> [Text] -> Sh ()
run_
instance (CmdArg arg, ShellCmd result) => ShellCmd (arg -> result) where
cmdAll :: String -> [Text] -> arg -> result
cmdAll String
fp [Text]
acc arg
x = String -> [Text] -> result
forall t. ShellCmd t => String -> [Text] -> t
cmdAll String
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 :: String -> [Text] -> [arg] -> result
cmdAll String
fp [Text]
acc [arg]
x = String -> [Text] -> result
forall t. ShellCmd t => String -> [Text] -> t
cmdAll String
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)
cmd :: (ShellCmd result) => FilePath -> result
cmd :: String -> result
cmd String
fp = String -> [Text] -> result
forall t. ShellCmd t => String -> [Text] -> t
cmdAll String
fp []
fromText :: Text -> FilePath
fromText :: Text -> String
fromText = Text -> String
T.unpack
class ToFilePath a where
toFilePath :: a -> FilePath
instance ToFilePath FilePath where toFilePath :: String -> String
toFilePath = String -> String
forall a. a -> a
id
instance ToFilePath Text where toFilePath :: Text -> String
toFilePath = Text -> String
T.unpack
(</>) :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> FilePath
filepath1
x </> :: filepath1 -> filepath2 -> String
</> filepath2
y = filepath1 -> String
forall a. ToFilePath a => a -> String
toFilePath filepath1
x String -> String -> String
FP.</> filepath2 -> String
forall a. ToFilePath a => a -> String
toFilePath filepath2
y
(<.>) :: (ToFilePath filepath) => filepath -> Text -> FilePath
filepath
x <.> :: filepath -> Text -> String
<.> Text
y = filepath -> String
forall a. ToFilePath a => a -> String
toFilePath filepath
x String -> String -> String
FP.<.> Text -> String
T.unpack Text
y
toTextWarn :: FilePath -> Sh Text
toTextWarn :: String -> Sh Text
toTextWarn String
efile = do
Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
isValid String
efile) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text -> Sh ()
encodeError (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
makeValid String
efile)
Text -> Sh Text
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
makeValid String
efile)
where
encodeError :: Text -> Sh ()
encodeError Text
f = Text -> Sh ()
echo (Text
"non-unicode file name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f)
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
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)
transferFoldHandleLines :: a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
transferFoldHandleLines :: 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 :: 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
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 :: 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
tag :: Sh a -> Text -> Sh a
tag :: 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
-> String
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommandNoEscape [StdHandle]
handles State
st String
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
" " (String -> Text
toTextIgnore String
exe Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)
runCommand :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand :: [StdHandle]
-> State
-> String
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand [StdHandle]
handles State
st String
exe [Text]
args = String -> Sh String
findExe String
exe Sh String
-> (String -> Sh (Handle, Handle, Handle, ProcessHandle))
-> Sh (Handle, Handle, Handle, ProcessHandle)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
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 String
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 :: String -> Sh String
findExe
#if defined(mingw32_HOST_OS)
fp
#else
String
_fp
#endif
= do
Either String String
mExe <- String -> Sh (Either String String)
whichEith String
exe
case Either String String
mExe of
Right String
execFp -> String -> Sh String
forall (m :: * -> *) a. Monad m => a -> m a
return String
execFp
#if defined(mingw32_HOST_OS)
Left _ -> return fp
#else
Left String
err -> 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
$ IOError -> IO String
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO String) -> IOError -> IO String
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
-> Maybe String
-> Maybe [(String, String)]
-> StdStream
-> StdStream
-> StdStream
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe GroupID
-> Maybe UserID
-> Bool
-> 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
$ State -> String
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
, create_group :: Bool
create_group = Bool
False
, delegate_ctlc :: Bool
delegate_ctlc = Bool
False
, detach_console :: Bool
detach_console = Bool
False
, create_new_console :: Bool
create_new_console = Bool
False
, new_session :: Bool
new_session = Bool
False
, child_group :: Maybe GroupID
child_group = Maybe GroupID
forall a. Maybe a
Nothing
, child_user :: Maybe UserID
child_user = Maybe UserID
forall a. Maybe a
Nothing
#if MIN_VERSION_process(1,5,0)
, use_process_jobs :: Bool
use_process_jobs = Bool
False
#endif
}
(Handle, Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, Handle, ProcessHandle)
forall (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 :: 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 (Just StdStream
NoStream) = String -> Maybe Handle
forall a. HasCallStack => String -> a
error String
"shelly process creation failure NoStream"
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
catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a
catch_sh :: 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)
handle_sh :: (Exception e) => (e -> Sh a) -> Sh a -> Sh a
handle_sh :: (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)
finally_sh :: Sh a -> Sh b -> Sh a
finally_sh :: 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 :: 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)
data ShellyHandler a = forall e . Exception e => ShellyHandler (e -> Sh a)
catches_sh :: Sh a -> [ShellyHandler a] -> Sh a
catches_sh :: 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 :: (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))
catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a
catchany_sh :: 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
handleany_sh :: (SomeException -> Sh a) -> Sh a -> Sh a
handleany_sh :: (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
cd :: FilePath -> Sh ()
cd :: String -> Sh ()
cd = (Text -> Text) -> String -> Sh String
traceCanonicPath (Text
"cd " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (String -> Sh String) -> (String -> Sh ()) -> String -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Sh ()
cd'
where
cd' :: String -> Sh ()
cd' String
dir = do
Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (String -> Sh Bool
test_d String
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 :: String
sDirectory = String
dir, sPathExecutables :: Maybe [(String, Set String)]
sPathExecutables = Maybe [(String, Set String)]
forall a. Maybe a
Nothing }
where
tdir :: Text
tdir = String -> Text
toTextIgnore String
dir
chdir :: FilePath -> Sh a -> Sh a
chdir :: String -> Sh a -> Sh a
chdir String
dir Sh a
action = do
String
d <- (State -> String) -> Sh String
forall a. (State -> a) -> Sh a
gets State -> String
sDirectory
String -> Sh ()
cd String
dir
Sh a
action Sh a -> Sh () -> Sh a
forall a b. Sh a -> Sh b -> Sh a
`finally_sh` String -> Sh ()
cd String
d
chdir_p :: FilePath -> Sh a -> Sh a
chdir_p :: String -> Sh a -> Sh a
chdir_p String
d Sh a
action = String -> Sh ()
mkdir_p String
d Sh () -> Sh a -> Sh a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Sh a -> Sh a
forall a. String -> Sh a -> Sh a
chdir String
d Sh a
action
pack :: String -> FilePath
pack :: String -> String
pack = String -> String
forall a. a -> a
id
mv :: FilePath -> FilePath -> Sh ()
mv :: String -> String -> Sh ()
mv String
from' String
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
<> String -> Text
toTextIgnore String
from' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
toTextIgnore String
to'
String
from <- String -> Sh String
absPath String
from'
Bool
from_dir <- String -> Sh Bool
test_d String
from
String
to <- String -> Sh String
absPath String
to'
Bool
to_dir <- String -> Sh Bool
test_d String
to
let to_loc :: String
to_loc = if Bool -> Bool
not Bool
to_dir then String
to else String
to String -> String -> String
FP.</> (String -> String
FP.takeFileName String
from)
IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
to_loc)
if Bool -> Bool
not Bool
from_dir
then 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 ()
renameFile String
from String
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 (String -> String -> String
extraMsg String
to_loc String
from)
)
else 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 ()
renameDirectory String
from String
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 (String -> String -> String
extraMsg String
to_loc String
from)
)
where
extraMsg :: String -> String -> String
extraMsg :: String -> String -> String
extraMsg String
t String
f = String
"during copy from: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
lsT :: FilePath -> Sh [Text]
lsT :: String -> Sh [Text]
lsT = String -> Sh [String]
ls (String -> Sh [String])
-> ([String] -> Sh [Text]) -> String -> Sh [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> Sh Text) -> [String] -> Sh [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Sh Text
toTextWarn
pwd :: Sh FilePath
pwd :: Sh String
pwd = (State -> String) -> Sh String
forall a. (State -> a) -> Sh a
gets State -> String
sDirectory Sh String -> Text -> Sh String
forall a. Sh a -> Text -> Sh a
`tag` Text
"pwd"
exit :: Int -> Sh a
exit :: 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))
errorExit :: Text -> Sh a
errorExit :: 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
quietExit :: Int -> Sh a
quietExit :: 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
terror :: Text -> Sh a
terror :: 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
mkdir :: FilePath -> Sh ()
mkdir :: String -> Sh ()
mkdir = (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"mkdir " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (String -> Sh String) -> (String -> Sh ()) -> String -> 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 ()) -> (String -> IO ()) -> String -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> IO ()
createDirectoryIfMissing Bool
False
mkdir_p :: FilePath -> Sh ()
mkdir_p :: String -> Sh ()
mkdir_p = (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"mkdir -p " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (String -> Sh String) -> (String -> Sh ()) -> String -> 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 ()) -> (String -> IO ()) -> String -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> IO ()
createDirectoryIfMissing Bool
True
mkdirTree :: Tree FilePath -> Sh ()
mkdirTree :: Tree String -> Sh ()
mkdirTree = Tree String -> Sh ()
mk (Tree String -> Sh ())
-> (Tree String -> Tree String) -> Tree String -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> Tree String
unrollPath
where mk :: Tree FilePath -> Sh ()
mk :: Tree String -> Sh ()
mk (Node String
a [Tree String]
ts) = do
Bool
b <- String -> Sh Bool
test_d String
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
$ String -> Sh ()
mkdir String
a
String -> Sh () -> Sh ()
forall a. String -> Sh a -> Sh a
chdir String
a (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ (Tree String -> Sh ()) -> [Tree String] -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Tree String -> Sh ()
mkdirTree [Tree String]
ts
unrollPath :: Tree FilePath -> Tree FilePath
unrollPath :: Tree String -> Tree String
unrollPath (Node String
v [Tree String]
ts) = String -> [Tree String] -> Tree String
unrollRoot String
v ([Tree String] -> Tree String) -> [Tree String] -> Tree String
forall a b. (a -> b) -> a -> b
$ (Tree String -> Tree String) -> [Tree String] -> [Tree String]
forall a b. (a -> b) -> [a] -> [b]
map Tree String -> Tree String
unrollPath [Tree String]
ts
where unrollRoot :: String -> [Tree String] -> Tree String
unrollRoot String
x = (([Tree String] -> Tree String)
-> ([Tree String] -> Tree String) -> [Tree String] -> Tree String)
-> [[Tree String] -> Tree String] -> [Tree String] -> Tree String
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ([Tree String] -> Tree String)
-> ([Tree String] -> Tree String) -> [Tree String] -> Tree String
forall (m :: * -> *) a c a.
Monad m =>
(m a -> c) -> (a -> a) -> a -> c
phi ([[Tree String] -> Tree String] -> [Tree String] -> Tree String)
-> [[Tree String] -> Tree String] -> [Tree String] -> Tree String
forall a b. (a -> b) -> a -> b
$ (String -> [Tree String] -> Tree String)
-> [String] -> [[Tree String] -> Tree String]
forall a b. (a -> b) -> [a] -> [b]
map String -> [Tree String] -> Tree String
forall a. a -> [Tree a] -> Tree a
Node ([String] -> [[Tree String] -> Tree String])
-> [String] -> [[Tree String] -> Tree String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
splitDirectories String
x
phi :: (m a -> c) -> (a -> a) -> a -> c
phi m a -> c
a a -> a
b = m a -> c
a (m a -> c) -> (a -> m a) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (a -> a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
b
isExecutable :: FilePath -> IO Bool
isExecutable :: String -> IO Bool
isExecutable String
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 String
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)
which :: FilePath -> Sh (Maybe FilePath)
which :: String -> Sh (Maybe String)
which String
fp = (String -> Maybe String)
-> (String -> Maybe String) -> Either String String -> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe String -> String -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) String -> Maybe String
forall a. a -> Maybe a
Just (Either String String -> Maybe String)
-> Sh (Either String String) -> Sh (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Sh (Either String String)
whichEith String
fp
whichEith :: FilePath -> Sh (Either String FilePath)
whichEith :: String -> Sh (Either String String)
whichEith String
originalFp = String -> Sh (Either String String)
whichFull
#if defined(mingw32_HOST_OS)
$ case takeExtension originalFp of
"" -> originalFp <.> "exe"
_ -> originalFp
#else
String
originalFp
#endif
where
whichFull :: String -> Sh (Either String String)
whichFull String
fp = do
(Text -> Sh ()
trace (Text -> Sh ()) -> (String -> Text) -> String -> 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) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
toTextIgnore) String
fp Sh () -> Sh (Either String String) -> Sh (Either String String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh (Either String String)
whichUntraced
where
whichUntraced :: Sh (Either String String)
whichUntraced | String -> Bool
isAbsolute String
fp = Sh (Either String String)
checkFile
| [String] -> Bool
forall a. (Eq a, IsString a) => [a] -> Bool
dotSlash [String]
splitOnDirs = Sh (Either String String)
checkFile
| [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
splitOnDirs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Sh (Maybe String)
lookupPath Sh (Maybe String)
-> (Maybe String -> Sh (Either String String))
-> Sh (Either String String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> Sh (Either String String)
leftPathError
| Bool
otherwise = Sh (Maybe String)
lookupCache Sh (Maybe String)
-> (Maybe String -> Sh (Either String String))
-> Sh (Either String String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> Sh (Either String String)
leftPathError
splitOnDirs :: [String]
splitOnDirs = String -> [String]
splitDirectories String
fp
dotSlash :: [a] -> Bool
dotSlash (a
"./":[a]
_) = Bool
True
dotSlash [a]
_ = Bool
False
checkFile :: Sh (Either String FilePath)
checkFile :: Sh (Either String String)
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
$ String -> IO Bool
doesFileExist String
fp
Either String String -> Sh (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> Sh (Either String String))
-> Either String String -> Sh (Either String String)
forall a b. (a -> b) -> a -> b
$ if Bool
exists then String -> Either String String
forall a b. b -> Either a b
Right String
fp else
String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"did not find file: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp
leftPathError :: Maybe FilePath -> Sh (Either String FilePath)
leftPathError :: Maybe String -> Sh (Either String String)
leftPathError Maybe String
Nothing = String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String)
-> Sh String -> Sh (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh String
pathLookupError
leftPathError (Just String
x) = Either String String -> Sh (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> Sh (Either String String))
-> Either String String -> Sh (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right String
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` String
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 String)
lookupPath = (Sh [String]
pathDirs Sh [String] -> ([String] -> Sh (Maybe String)) -> Sh (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) (([String] -> Sh (Maybe String)) -> Sh (Maybe String))
-> ([String] -> Sh (Maybe String)) -> Sh (Maybe String)
forall a b. (a -> b) -> a -> b
$ (String -> Sh (Maybe String)) -> [String] -> Sh (Maybe String)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM ((String -> Sh (Maybe String)) -> [String] -> Sh (Maybe String))
-> (String -> Sh (Maybe String)) -> [String] -> Sh (Maybe String)
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
let fullFp :: String
fullFp = String
dir String -> String -> String
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> String
</> String
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
$ String -> IO Bool
isExecutable String
fullFp
Maybe String -> Sh (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Sh (Maybe String))
-> Maybe String -> Sh (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
res then String -> Maybe String
forall a. a -> Maybe a
Just String
fullFp else Maybe String
forall a. Maybe a
Nothing
lookupCache :: Sh (Maybe FilePath)
lookupCache :: Sh (Maybe String)
lookupCache = do
[(String, Set String)]
pathExecutables <- Sh [(String, Set String)]
cachedPathExecutables
Maybe String -> Sh (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Sh (Maybe String))
-> Maybe String -> Sh (Maybe String)
forall a b. (a -> b) -> a -> b
$ ((String, Set String) -> String)
-> Maybe (String, Set String) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> String -> String) -> String -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> String
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> String
(</>) String
fp (String -> String)
-> ((String, Set String) -> String)
-> (String, Set String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Set String) -> String
forall a b. (a, b) -> a
fst) (Maybe (String, Set String) -> Maybe String)
-> Maybe (String, Set String) -> Maybe String
forall a b. (a -> b) -> a -> b
$
((String, Set String) -> Bool)
-> [(String, Set String)] -> Maybe (String, Set String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
fp (Set String -> Bool)
-> ((String, Set String) -> Set String)
-> (String, Set String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Set String) -> Set String
forall a b. (a, b) -> b
snd) [(String, Set String)]
pathExecutables
pathDirs :: Sh [String]
pathDirs = (String -> Sh String) -> [String] -> Sh [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Sh String
absPath ([String] -> Sh [String]) -> Sh [String] -> Sh [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> (Text -> [Text]) -> Text -> [String]
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 -> [String]) -> Sh Text -> Sh [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> Sh Text
get_env_text Text
"PATH")
cachedPathExecutables :: Sh [(FilePath, Set FilePath)]
cachedPathExecutables :: Sh [(String, Set String)]
cachedPathExecutables = do
Maybe [(String, Set String)]
mPathExecutables <- (State -> Maybe [(String, Set String)])
-> Sh (Maybe [(String, Set String)])
forall a. (State -> a) -> Sh a
gets State -> Maybe [(String, Set String)]
sPathExecutables
case Maybe [(String, Set String)]
mPathExecutables of
Just [(String, Set String)]
pExecutables -> [(String, Set String)] -> Sh [(String, Set String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String, Set String)]
pExecutables
Maybe [(String, Set String)]
Nothing -> do
[String]
dirs <- Sh [String]
pathDirs
[Set String]
executables <- [String] -> (String -> Sh (Set String)) -> Sh [Set String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
dirs (\String
dir -> do
[String]
files <- (IO [String] -> Sh [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Sh [String])
-> (String -> IO [String]) -> String -> Sh [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO [String]
listDirectory) String
dir Sh [String] -> (IOError -> Sh [String]) -> Sh [String]
forall e a. Exception e => Sh a -> (e -> Sh a) -> Sh a
`catch_sh` (\(IOError
_ :: IOError) -> [String] -> Sh [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
[String]
exes <- ([(String, String)] -> [String])
-> Sh [(String, String)] -> Sh [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd) (Sh [(String, String)] -> Sh [String])
-> Sh [(String, String)] -> Sh [String]
forall a b. (a -> b) -> a -> b
$ IO [(String, String)] -> Sh [(String, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, String)] -> Sh [(String, String)])
-> IO [(String, String)] -> Sh [(String, String)]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> IO Bool)
-> [(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> IO Bool
isExecutable (String -> IO Bool)
-> ((String, String) -> String) -> (String, String) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) ([(String, String)] -> IO [(String, String)])
-> [(String, String)] -> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$
(String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
f -> (String
f, String -> String
takeFileName String
f)) [String]
files
Set String -> Sh (Set String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set String -> Sh (Set String)) -> Set String -> Sh (Set String)
forall a b. (a -> b) -> a -> b
$ [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
exes
)
let cachedExecutables :: [(String, Set String)]
cachedExecutables = [String] -> [Set String] -> [(String, Set String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
dirs [Set String]
executables
(State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$ \State
x -> State
x { sPathExecutables :: Maybe [(String, Set String)]
sPathExecutables = [(String, Set String)] -> Maybe [(String, Set String)]
forall a. a -> Maybe a
Just [(String, Set String)]
cachedExecutables }
[(String, Set String)] -> Sh [(String, Set String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, Set String)] -> Sh [(String, Set String)])
-> [(String, Set String)] -> Sh [(String, Set String)]
forall a b. (a -> b) -> a -> b
$ [(String, Set String)]
cachedExecutables
findMapM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM :: (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
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: 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
test_e :: FilePath -> Sh Bool
test_e :: String -> Sh Bool
test_e = String -> Sh String
absPath (String -> Sh String) -> (String -> Sh Bool) -> String -> Sh Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \String
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 <- String -> IO Bool
doesFileExist String
f
if Bool
file then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else String -> IO Bool
doesDirectoryExist String
f
test_f :: FilePath -> Sh Bool
test_f :: String -> Sh Bool
test_f = String -> Sh String
absPath (String -> Sh String) -> (String -> Sh Bool) -> String -> 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) -> (String -> IO Bool) -> String -> Sh Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist
test_px :: FilePath -> Sh Bool
test_px :: String -> Sh Bool
test_px String
exe = do
Maybe String
mFull <- String -> Sh (Maybe String)
which String
exe
case Maybe String
mFull of
Maybe String
Nothing -> Bool -> Sh Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just String
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
$ String -> IO Bool
isExecutable String
full
rm_rf :: FilePath -> Sh ()
rm_rf :: String -> Sh ()
rm_rf String
infp = do
String
f <- (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"rm -rf " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) String
infp
Bool
isDir <- (String -> Sh Bool
test_d String
f)
if Bool -> Bool
not Bool
isDir then Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (String -> Sh Bool
test_f String
f) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ String -> Sh ()
rm_f String
f
else
(IO () -> Sh ()
forall a. IO a -> Sh ()
liftIO_ (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
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
String -> Sh [String]
find String
f Sh [String] -> ([String] -> Sh ()) -> Sh ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Sh ()) -> [String] -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
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 String
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
$ String -> IO ()
removeDirectoryRecursive String
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
rm_f :: FilePath -> Sh ()
rm_f :: String -> Sh ()
rm_f = (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (String -> Sh String) -> (String -> Sh ()) -> String -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \String
f ->
Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (String -> Sh Bool
test_e String
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
$ String -> IO ()
removeFile String
f
rm :: FilePath -> Sh ()
rm :: String -> Sh ()
rm = (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (String -> Sh String) -> (String -> Sh ()) -> String -> 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 ()) -> (String -> IO ()) -> String -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
removeFile
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 [(String, Set String)]
sPathExecutables = Maybe [(String, Set String)]
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"
appendToPath :: FilePath -> Sh ()
appendToPath :: String -> Sh ()
appendToPath = (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"appendToPath: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (String -> Sh String) -> (String -> Sh ()) -> String -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \String
filepath -> do
Text
tp <- String -> Sh Text
toTextWarn String
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
prependToPath :: FilePath -> Sh ()
prependToPath :: String -> Sh ()
prependToPath = (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"prependToPath: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (String -> Sh String) -> (String -> Sh ()) -> String -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \String
filepath -> do
Text
tp <- String -> Sh Text
toTextWarn String
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_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
normalizeEnvVarNameText :: Text -> Text
#if defined(mingw32_HOST_OS)
normalizeEnvVarNameText = T.toLower
#else
normalizeEnvVarNameText :: Text -> Text
normalizeEnvVarNameText = Text -> Text
forall a. a -> a
id
#endif
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
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" #-}
get_env_text :: Text -> Sh Text
get_env_text :: Text -> Sh Text
get_env_text = Text -> Text -> Sh Text
get_env_def Text
""
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" #-}
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
initAllHandles :: HandleInitializer -> StdInit
initAllHandles :: HandleInitializer -> StdInit
initAllHandles HandleInitializer
f = HandleInitializer
-> HandleInitializer -> HandleInitializer -> StdInit
StdInit HandleInitializer
f HandleInitializer
f HandleInitializer
f
onCommandHandles :: StdInit -> Sh a -> Sh a
onCommandHandles :: 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
silently :: Sh a -> Sh a
silently :: 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
verbosely :: Sh a -> Sh a
verbosely :: 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
log_stdout_with :: (Text -> IO ()) -> Sh a -> Sh a
log_stdout_with :: (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
log_stderr_with :: (Text -> IO ()) -> Sh a -> Sh a
log_stderr_with :: (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
print_stdout :: Bool -> Sh a -> Sh a
print_stdout :: 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
print_stderr :: Bool -> Sh a -> Sh a
print_stderr :: 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
print_commands :: Bool -> Sh a -> Sh a
print_commands :: 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
sub :: Sh a -> Sh a
sub :: 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 {
sTrace :: Text
sTrace = State -> Text
sTrace State
oldState Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> State -> Text
sTrace State
newState
, sCode :: Int
sCode = State -> Int
sCode State
newState
, sStderr :: Text
sStderr = State -> Text
sStderr State
newState
, sStdin :: Maybe Text
sStdin = State -> Maybe Text
sStdin State
newState
}
tracing :: Bool -> Sh a -> Sh a
tracing :: 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
escaping :: Bool -> Sh a -> Sh a
escaping :: 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
errExit :: Bool -> Sh a -> Sh a
errExit :: 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
followSymlink :: Bool -> Sh a -> Sh a
followSymlink :: 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 :: Bool -> ReadOnlyState
ReadOnlyState { rosFailToDir :: Bool
rosFailToDir = Bool
False }
shellyNoDir :: MonadIO m => Sh a -> m a
shellyNoDir :: Sh a -> m a
shellyNoDir = ReadOnlyState -> Sh a -> m a
forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState :: Bool -> ReadOnlyState
ReadOnlyState { rosFailToDir :: Bool
rosFailToDir = Bool
False }
{-# DEPRECATED shellyNoDir "Just use shelly. The default settings have changed" #-}
shellyFailDir :: MonadIO m => Sh a -> m a
shellyFailDir :: Sh a -> m a
shellyFailDir = ReadOnlyState -> Sh a -> m a
forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState :: Bool -> ReadOnlyState
ReadOnlyState { rosFailToDir :: Bool
rosFailToDir = Bool
True }
getNormalizedEnvironment :: IO [(String, String)]
getNormalizedEnvironment :: IO [(String, String)]
getNormalizedEnvironment =
#if defined(mingw32_HOST_OS)
fmap (\(a, b) -> (map toLower a, b)) <$> getEnvironment
#else
IO [(String, String)]
getEnvironment
#endif
shelly :: MonadIO m => Sh a -> m a
shelly :: 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' :: 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
String
dir <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
let def :: State
def = State :: Int
-> Maybe Text
-> Text
-> String
-> (Text -> IO ())
-> Bool
-> (Text -> IO ())
-> Bool
-> Bool
-> StdInit
-> Bool
-> [(String, String)]
-> Maybe [(String, Set String)]
-> Bool
-> Text
-> Bool
-> ReadOnlyState
-> Bool
-> State
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 :: String
sDirectory = String
dir
, sPathExecutables :: Maybe [(String, Set String)]
sPathExecutables = Maybe [(String, Set String)]
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 :: 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
String
d <- Sh String
pwd
String
sf <- Sh String
shellyFile
let logFile :: String
logFile = String
dString -> String -> String
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> String
</>String
shelly_dirString -> String -> String
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> String
</>String
sf
(String -> Text -> Sh ()
writefile String
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
<> String
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 :: String
shelly_dir = String
".shelly"
shellyFile :: Sh String
shellyFile = String -> Sh String -> Sh String
forall a. String -> Sh a -> Sh a
chdir_p String
shelly_dir (Sh String -> Sh String) -> Sh String -> Sh String
forall a b. (a -> b) -> a -> b
$ do
[String]
fs <- String -> Sh [String]
ls String
"."
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 -> String
pack (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show ([String] -> Int
nextNum [String]
fs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".txt"
nextNum :: [FilePath] -> Int
nextNum :: [String] -> Int
nextNum [] = Int
1
nextNum [String]
fs = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> ([String] -> Int) -> [String] -> 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) -> ([String] -> [Int]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> Int
forall a. Read a => a -> String -> a
readDef Int
1 (String -> Int) -> (String -> String) -> String -> 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) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeFileName) ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ [String]
fs
readDef :: Read a => a -> String -> a
readDef :: 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 :: 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 String
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 (String -> [Text] -> Text
show_command String
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 :: String -> [Text] -> Text
show_command String
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 (String -> Text
toTextIgnore String
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
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
quoteCommand :: FilePath -> [Text] -> Text
quoteCommand :: String -> [Text] -> Text
quoteCommand String
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 (String -> Text
toTextIgnore String
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 = | SeqSsh
sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh ()
sshPairs_ :: Text -> [(String, [Text])] -> Sh ()
sshPairs_ Text
_ [] = () -> Sh ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sshPairs_ Text
server [(String, [Text])]
cmds = (String -> [Text] -> Sh ()) -> Text -> [(String, [Text])] -> Sh ()
forall a.
(String -> [Text] -> Sh a) -> Text -> [(String, [Text])] -> Sh a
sshPairs' String -> [Text] -> Sh ()
run_ Text
server [(String, [Text])]
cmds
sshPairsPar_ :: Text -> [(FilePath, [Text])] -> Sh ()
sshPairsPar_ :: Text -> [(String, [Text])] -> Sh ()
sshPairsPar_ Text
_ [] = () -> Sh ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sshPairsPar_ Text
server [(String, [Text])]
cmds = (String -> [Text] -> Sh ()) -> Text -> [(String, [Text])] -> Sh ()
forall a.
(String -> [Text] -> Sh a) -> Text -> [(String, [Text])] -> Sh a
sshPairsPar' String -> [Text] -> Sh ()
run_ Text
server [(String, [Text])]
cmds
sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text
sshPairs :: Text -> [(String, [Text])] -> Sh Text
sshPairs Text
_ [] = Text -> Sh Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairs Text
server [(String, [Text])]
cmds = (String -> [Text] -> Sh Text)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh Text
forall a.
(String -> [Text] -> Sh a)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' String -> [Text] -> Sh Text
run Text
server [] [(String, [Text])]
cmds SshMode
SeqSsh
sshPairsPar :: Text -> [(FilePath, [Text])] -> Sh Text
sshPairsPar :: Text -> [(String, [Text])] -> Sh Text
sshPairsPar Text
_ [] = Text -> Sh Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairsPar Text
server [(String, [Text])]
cmds = (String -> [Text] -> Sh Text)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh Text
forall a.
(String -> [Text] -> Sh a)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' String -> [Text] -> Sh Text
run Text
server [] [(String, [Text])]
cmds SshMode
ParSsh
sshPairsPar' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
sshPairsPar' :: (String -> [Text] -> Sh a) -> Text -> [(String, [Text])] -> Sh a
sshPairsPar' String -> [Text] -> Sh a
run' Text
server [(String, [Text])]
actions = (String -> [Text] -> Sh a)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh a
forall a.
(String -> [Text] -> Sh a)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' String -> [Text] -> Sh a
run' Text
server [] [(String, [Text])]
actions SshMode
ParSsh
sshPairs' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
sshPairs' :: (String -> [Text] -> Sh a) -> Text -> [(String, [Text])] -> Sh a
sshPairs' String -> [Text] -> Sh a
run' Text
server [(String, [Text])]
actions = (String -> [Text] -> Sh a)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh a
forall a.
(String -> [Text] -> Sh a)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' String -> [Text] -> Sh a
run' Text
server [] [(String, [Text])]
actions SshMode
SeqSsh
sshPairsWithOptions :: Text
-> [Text]
-> [(FilePath, [Text])]
-> Sh Text
sshPairsWithOptions :: Text -> [Text] -> [(String, [Text])] -> Sh Text
sshPairsWithOptions Text
_ [Text]
_ [] = Text -> Sh Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairsWithOptions Text
server [Text]
sshargs [(String, [Text])]
cmds = (String -> [Text] -> Sh Text)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh Text
forall a.
(String -> [Text] -> Sh a)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' String -> [Text] -> Sh Text
run Text
server [Text]
sshargs [(String, [Text])]
cmds SshMode
SeqSsh
sshPairsWithOptions' :: (FilePath -> [Text] -> Sh a) -> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' :: (String -> [Text] -> Sh a)
-> Text -> [Text] -> [(String, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' String -> [Text] -> Sh a
run' Text
server [Text]
sshargs [(String, [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
String -> [Text] -> Sh a
run' String
"ssh" ([Text
server] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sshargs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [[(String, [Text])] -> SshMode -> Text
sshCommandText [(String, [Text])]
actions SshMode
mode])
sshCommandText :: [(FilePath, [Text])] -> SshMode -> Text
sshCommandText :: [(String, [Text])] -> SshMode -> Text
sshCommandText [(String, [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 (((String, [Text]) -> Text) -> [(String, [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [Text] -> Text) -> (String, [Text]) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [Text] -> Text
quoteCommand) [(String, [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
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
run :: FilePath -> [Text] -> Sh Text
run :: String -> [Text] -> Sh Text
run String
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) -> String -> [Text] -> Sh (Seq Text)
forall a. a -> FoldCallback a -> String -> [Text] -> Sh a
runFoldLines Seq Text
forall a. Monoid a => a
mempty FoldCallback (Seq Text)
forall a. Seq a -> a -> Seq a
(|>) String
fp [Text]
args
bash :: FilePath -> [Text] -> Sh Text
bash :: String -> [Text] -> Sh Text
bash String
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
$ String -> [Text] -> Sh Text
run String
"bash" ([Text] -> Sh Text) -> [Text] -> Sh Text
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> [Text]
bashArgs String
fp [Text]
args
bash_ :: FilePath -> [Text] -> Sh ()
bash_ :: String -> [Text] -> Sh ()
bash_ String
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
$ String -> [Text] -> Sh ()
run_ String
"bash" ([Text] -> Sh ()) -> [Text] -> Sh ()
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> [Text]
bashArgs String
fp [Text]
args
bashArgs :: FilePath -> [Text] -> [Text]
bashArgs :: String -> [Text] -> [Text]
bashArgs String
fp [Text]
args = [Text
"-c", Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
sanitise (String -> Text
toTextIgnore String
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
" "
bashPipeFail :: (FilePath -> [Text] -> Sh a) -> FilePath -> [Text] -> Sh a
bashPipeFail :: (String -> [Text] -> Sh a) -> String -> [Text] -> Sh a
bashPipeFail String -> [Text] -> Sh a
runner String
fp [Text]
args = String -> [Text] -> Sh a
runner String
"set -o pipefail;" (String -> Text
toTextIgnore String
fp Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)
command :: FilePath -> [Text] -> [Text] -> Sh Text
command :: String -> [Text] -> [Text] -> Sh Text
command String
com [Text]
args [Text]
more_args = String -> [Text] -> Sh Text
run String
com ([Text]
args [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
more_args)
command_ :: FilePath -> [Text] -> [Text] -> Sh ()
command_ :: String -> [Text] -> [Text] -> Sh ()
command_ String
com [Text]
args [Text]
more_args = String -> [Text] -> Sh ()
run_ String
com ([Text]
args [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
more_args)
command1 :: FilePath -> [Text] -> Text -> [Text] -> Sh Text
command1 :: String -> [Text] -> Text -> [Text] -> Sh Text
command1 String
com [Text]
args Text
one_arg [Text]
more_args = String -> [Text] -> Sh Text
run String
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)
command1_ :: FilePath -> [Text] -> Text -> [Text] -> Sh ()
command1_ :: String -> [Text] -> Text -> [Text] -> Sh ()
command1_ String
com [Text]
args Text
one_arg [Text]
more_args = String -> [Text] -> Sh ()
run_ String
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)
run_ :: FilePath -> [Text] -> Sh ()
run_ :: String -> [Text] -> Sh ()
run_ String
exe [Text]
args = do
State
state <- Sh State
get
if State -> Bool
sPrintStdout State
state
then Sh ()
runWithColor_
else () -> FoldCallback () -> String -> [Text] -> Sh ()
forall a. a -> FoldCallback a -> String -> [Text] -> Sh a
runFoldLines () (\()
_ Text
_ -> ()) String
exe [Text]
args
where
runWithColor_ :: Sh ()
runWithColor_ =
String
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh ())
-> Sh ()
forall a.
String
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles String
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
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_ :: 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
runHandle :: FilePath
-> [Text]
-> (Handle -> Sh a)
-> Sh a
runHandle :: String -> [Text] -> (Handle -> Sh a) -> Sh a
runHandle String
exe [Text]
args Handle -> Sh a
withHandle = String
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
forall a.
String
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles String
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
runHandles
:: FilePath
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles :: String
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles String
exe [Text]
args [StdHandle]
reusedHandles Handle -> Handle -> Handle -> Sh a
withHandles = do
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 = String -> [Text] -> Text
show_command String
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
-> String
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
doRun = if State -> Bool
sCommandEscaping State
state then [StdHandle]
-> State
-> String
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand else [StdHandle]
-> State
-> String
-> [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
-> String
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
doRun [StdHandle]
reusedHandles State
state String
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
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
$ String -> [Text] -> Int -> Text -> RunFailed
RunFailed String
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
)
runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> Sh a
runFoldLines :: a -> FoldCallback a -> String -> [Text] -> Sh a
runFoldLines a
start FoldCallback a
cb String
exe [Text]
args =
String
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
forall a.
String
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles String
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
(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
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar :: 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
lastStderr :: Sh Text
lastStderr :: Sh Text
lastStderr = (State -> Text) -> Sh Text
forall a. (State -> a) -> Sh a
gets State -> Text
sStderr
lastExitCode :: Sh Int
lastExitCode :: Sh Int
lastExitCode = (State -> Int) -> Sh Int
forall a. (State -> a) -> Sh a
gets State -> Int
sCode
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 }
(-|-) :: Sh Text -> Sh b -> Sh b
Sh Text
one -|- :: 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
cp_r :: FilePath -> FilePath -> Sh ()
cp_r :: String -> String -> Sh ()
cp_r String
from' String
to' = do
String
from <- String -> Sh String
absPath String
from'
Bool
fromIsDir <- (String -> Sh Bool
test_d String
from)
if Bool -> Bool
not Bool
fromIsDir then Bool -> String -> String -> Sh ()
cp_should_follow_symlinks Bool
False String
from' String
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
<> String -> Text
toTextIgnore String
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
toTextIgnore String
to'
String
to <- String -> Sh String
absPath String
to'
Bool
toIsDir <- String -> Sh Bool
test_d String
to
Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
from String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
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
<>
String -> Text
toTextIgnore String
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
toTextIgnore String
to Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are identical"
String
finalTo <- if Bool -> Bool
not Bool
toIsDir then do
String -> Sh ()
mkdir String
to
String -> Sh String
forall (m :: * -> *) a. Monad m => a -> m a
return String
to
else do
let d :: String
d = String
to String -> String -> String
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> String
</> ([String] -> String
forall a. [a] -> a
last ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitPath (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory (String -> String
addTrailingPathSeparator String
from))
String -> Sh ()
mkdir_p String
d 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
d
String -> Sh [String]
ls String
from Sh [String] -> ([String] -> Sh ()) -> Sh ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Sh ()) -> [String] -> Sh ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
item -> do
String -> String -> Sh ()
cp_r (String
from String -> String -> String
FP.</> String -> String
takeFileName String
item) (String
finalTo String -> String -> String
FP.</> String -> String
takeFileName String
item))
cp :: FilePath -> FilePath -> Sh ()
cp :: String -> String -> Sh ()
cp = Bool -> String -> String -> Sh ()
cp_should_follow_symlinks Bool
True
cp_should_follow_symlinks :: Bool -> FilePath -> FilePath -> Sh ()
cp_should_follow_symlinks :: Bool -> String -> String -> Sh ()
cp_should_follow_symlinks Bool
shouldFollowSymlinks String
from' String
to' = do
String
from <- String -> Sh String
absPath String
from'
String
to <- String -> Sh String
absPath String
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
<> String -> Text
toTextIgnore String
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
toTextIgnore String
to
Bool
to_dir <- String -> Sh Bool
test_d String
to
let to_loc :: String
to_loc = if Bool
to_dir then String
to String -> String -> String
FP.</> String -> String
takeFileName String
from else String
to
if Bool
shouldFollowSymlinks then String -> String -> Sh ()
forall (m :: * -> *). MonadIO m => String -> String -> m ()
copyNormal String
from String
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 String
from
if Bool -> Bool
not Bool
isSymlink then String -> String -> Sh ()
forall (m :: * -> *). MonadIO m => String -> String -> m ()
copyNormal String
from String
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 String
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 String
to_loc
where
extraMsg :: String -> String -> String
extraMsg :: String -> String -> String
extraMsg String
t String
f = String
"during copy from: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
copyNormal :: String -> String -> m ()
copyNormal String
from String
to = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
copyFile String
from String
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 (String -> String -> String
extraMsg String
to String
from)
)
withTmpDir :: (FilePath -> Sh a) -> Sh a
withTmpDir :: (String -> Sh a) -> Sh a
withTmpDir String -> 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 :: String
p = String -> String
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
String -> Sh ()
rm_f String
p
String -> Sh ()
mkdir String
p
String -> Sh a
act String
p Sh a -> Sh () -> Sh a
forall a b. Sh a -> Sh b -> Sh a
`finally_sh` String -> Sh ()
rm_rf String
p
writefile :: FilePath -> Text -> Sh ()
writefile :: String -> Text -> Sh ()
writefile String
f' Text
bits = do
String
f <- (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"writefile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) String
f'
IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Text -> IO ()
TIO.writeFile String
f Text
bits)
writeBinary :: FilePath -> ByteString -> Sh ()
writeBinary :: String -> ByteString -> Sh ()
writeBinary String
f' ByteString
bytes = do
String
f <- (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"writeBinary " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) String
f'
IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> ByteString -> IO ()
BS.writeFile String
f ByteString
bytes)
touchfile :: FilePath -> Sh ()
touchfile :: String -> Sh ()
touchfile = (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"touch " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (String -> Sh String) -> (String -> Sh ()) -> String -> Sh ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> Text -> Sh ()) -> Text -> String -> Sh ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Text -> Sh ()
appendfile Text
""
appendfile :: FilePath -> Text -> Sh ()
appendfile :: String -> Text -> Sh ()
appendfile String
f' Text
bits = do
String
f <- (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"appendfile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) String
f'
IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Text -> IO ()
TIO.appendFile String
f Text
bits)
readfile :: FilePath -> Sh Text
readfile :: String -> Sh Text
readfile = (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"readfile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (String -> Sh String) -> (String -> Sh Text) -> String -> Sh Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \String
fp ->
String -> Sh ByteString
readBinary String
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
readBinary :: FilePath -> Sh ByteString
readBinary :: String -> Sh ByteString
readBinary = (Text -> Text) -> String -> Sh String
traceAbsPath (Text
"readBinary " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
(String -> Sh String)
-> (String -> Sh ByteString) -> String -> 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)
-> (String -> IO ByteString) -> String -> Sh ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
BS.readFile
hasExt :: Text -> FilePath -> Bool
hasExt :: Text -> String -> Bool
hasExt Text
ext String
fp = String -> Text
T.pack (String -> String
FP.takeExtension String
fp) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ext
time :: Sh a -> Sh (Double, a)
time :: 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)
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
*)
asyncSh :: Sh a -> Sh (Async a)
asyncSh :: 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)
tracePath :: (FilePath -> Sh FilePath)
-> (Text -> Text)
-> FilePath
-> Sh FilePath
tracePath :: (String -> Sh String) -> (Text -> Text) -> String -> Sh String
tracePath String -> Sh String
convert Text -> Text
tracer String
infp =
(String -> Sh String
convert String
infp Sh String -> (String -> Sh String) -> Sh String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
fp -> String -> Sh ()
traceIt String
fp 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
fp)
Sh String -> (SomeException -> Sh String) -> Sh String
forall a. Sh a -> (SomeException -> Sh a) -> Sh a
`catchany_sh` (\SomeException
e -> String -> Sh ()
traceIt String
infp Sh () -> Sh String -> Sh String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO String -> Sh String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeException -> IO String
forall e a. Exception e => e -> IO a
throwIO SomeException
e))
where traceIt :: String -> Sh ()
traceIt = Text -> Sh ()
trace (Text -> Sh ()) -> (String -> Text) -> String -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tracer (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
toTextIgnore
traceAbsPath :: (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath :: (Text -> Text) -> String -> Sh String
traceAbsPath = (String -> Sh String) -> (Text -> Text) -> String -> Sh String
tracePath String -> Sh String
absPath
traceCanonicPath :: (Text -> Text) -> FilePath -> Sh FilePath
traceCanonicPath :: (Text -> Text) -> String -> Sh String
traceCanonicPath = (String -> Sh String) -> (Text -> Text) -> String -> Sh String
tracePath String -> Sh String
canonic