{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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, liftM2 )
import Control.Monad.Trans ( MonadIO )
import Control.Monad.Reader (ask)
import Data.ByteString ( ByteString )
import Data.Char ( isAlphaNum, isDigit, isSpace, isPrint )
#if defined(mingw32_HOST_OS)
import Data.Char ( toLower )
#endif
import Data.Foldable ( toList )
import Data.IORef
import Data.Maybe
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ( (<>) )
#endif
import Data.Sequence ( Seq, (|>) )
import Data.Time.Clock ( getCurrentTime, diffUTCTime )
import Data.Tree ( Tree(..) )
import Data.Typeable
import qualified Data.ByteString as BS
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TE
import System.Directory
( setPermissions, getPermissions, Permissions(..), getTemporaryDirectory, pathIsSymbolicLink
, copyFile, removeFile, doesFileExist, doesDirectoryExist
, renameFile, renameDirectory, removeDirectoryRecursive, createDirectoryIfMissing
, getCurrentDirectory
)
import System.Environment
import System.Exit
import System.FilePath hiding ((</>), (<.>))
import qualified System.FilePath as FP
import System.IO ( Handle, hClose, stderr, stdout, openTempFile)
import System.IO.Error (isPermissionError, catchIOError, isEOFError, isIllegalOperation)
import System.Process
( CmdSpec(..), StdStream(CreatePipe, UseHandle), CreateProcess(..)
, createProcess, waitForProcess, terminateProcess
, ProcessHandle, StdStream(..)
)
class CmdArg a where
toTextArgs :: a -> [Text]
instance CmdArg Text where
toTextArgs :: Text -> [Text]
toTextArgs = (forall a. a -> [a] -> [a]
: [])
instance CmdArg String where
toTextArgs :: [Char] -> [Text]
toTextArgs = (forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
instance {-# OVERLAPPABLE #-} CmdArg a => CmdArg [a] where
toTextArgs :: [a] -> [Text]
toTextArgs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. CmdArg a => a -> [Text]
toTextArgs
class ShellCmd t where
cmdAll :: FilePath -> [Text] -> t
instance {-# INCOHERENT #-} s ~ () => ShellCmd (Sh s) where
cmdAll :: [Char] -> [Text] -> Sh s
cmdAll = [Char] -> [Text] -> Sh ()
run_
instance ShellCmd (Sh Text) where
cmdAll :: [Char] -> [Text] -> Sh Text
cmdAll = [Char] -> [Text] -> Sh Text
run
instance (CmdArg arg, ShellCmd result) => ShellCmd (arg -> result) where
cmdAll :: [Char] -> [Text] -> arg -> result
cmdAll [Char]
fp [Text]
acc arg
x = forall t. ShellCmd t => [Char] -> [Text] -> t
cmdAll [Char]
fp ([Text]
acc forall a. [a] -> [a] -> [a]
++ forall a. CmdArg a => a -> [Text]
toTextArgs arg
x)
cmd :: (ShellCmd result) => FilePath -> result
cmd :: forall result. ShellCmd result => [Char] -> result
cmd [Char]
fp = forall t. ShellCmd t => [Char] -> [Text] -> t
cmdAll [Char]
fp []
fromText :: Text -> FilePath
fromText :: Text -> [Char]
fromText = Text -> [Char]
T.unpack
class ToFilePath a where
toFilePath :: a -> FilePath
instance ToFilePath FilePath where toFilePath :: [Char] -> [Char]
toFilePath = forall a. a -> a
id
instance ToFilePath Text where toFilePath :: Text -> [Char]
toFilePath = Text -> [Char]
T.unpack
(</>) :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> FilePath
filepath1
x </> :: forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</> filepath2
y = forall a. ToFilePath a => a -> [Char]
toFilePath filepath1
x [Char] -> [Char] -> [Char]
FP.</> forall a. ToFilePath a => a -> [Char]
toFilePath filepath2
y
(<.>) :: (ToFilePath filepath) => filepath -> Text -> FilePath
filepath
x <.> :: forall filepath. ToFilePath filepath => filepath -> Text -> [Char]
<.> Text
y = forall a. ToFilePath a => a -> [Char]
toFilePath filepath
x [Char] -> [Char] -> [Char]
FP.<.> Text -> [Char]
T.unpack Text
y
toTextWarn :: FilePath -> Sh Text
toTextWarn :: [Char] -> Sh Text
toTextWarn [Char]
efile = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
isValid [Char]
efile) forall a b. (a -> b) -> a -> b
$ Text -> Sh ()
encodeError ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
makeValid [Char]
efile)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
makeValid [Char]
efile)
where
encodeError :: Text -> Sh ()
encodeError Text
f = Text -> Sh ()
echo (Text
"non-unicode file name: " 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 =
forall a. a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
transferFoldHandleLines forall a. Monoid a => a
mempty forall a. Seq a -> a -> Seq a
(|>) Handle
readHandle Text -> IO ()
putWrite forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a. Monad m => a -> m a
return 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Seq a -> a -> Seq a
(|>) Text
""
type FoldCallback a = (a -> Text -> a)
transferFoldHandleLines :: a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
transferFoldHandleLines :: forall a. a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
transferFoldHandleLines a
start FoldCallback a
foldLine Handle
readHandle Text -> IO ()
putWrite = a -> IO a
go a
start
where
go :: a -> IO a
go a
acc = do
Maybe Text
mLine <- forall a. IO a -> IO (Maybe a)
filterIOErrors forall a b. (a -> b) -> a -> b
$ Handle -> IO Text
TIO.hGetLine Handle
readHandle
case Maybe Text
mLine of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return a
acc
Just Text
line -> Text -> IO ()
putWrite Text
line forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
go (FoldCallback a
foldLine a
acc Text
line)
filterIOErrors :: IO a -> IO (Maybe a)
filterIOErrors :: forall a. IO a -> IO (Maybe a)
filterIOErrors IO a
action = forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall a. IOError -> IO a
ioError IOError
e)
foldHandleLines :: a -> FoldCallback a -> Handle -> IO a
foldHandleLines :: forall a. a -> FoldCallback a -> Handle -> IO a
foldHandleLines a
start FoldCallback a
foldLine Handle
readHandle = a -> IO a
go a
start
where
go :: a -> IO a
go a
acc = do
Maybe Text
mLine <- forall a. IO a -> IO (Maybe a)
filterIOErrors forall a b. (a -> b) -> a -> b
$ Handle -> IO Text
TIO.hGetLine Handle
readHandle
case Maybe Text
mLine of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return a
acc
Just Text
line -> a -> IO a
go forall a b. (a -> b) -> a -> b
$ FoldCallback a
foldLine a
acc Text
line
tag :: Sh a -> Text -> Sh a
tag :: forall a. Sh a -> Text -> Sh a
tag Sh a
action Text
msg = do
Text -> Sh ()
trace Text
msg
Sh a
action
put :: State -> Sh ()
put :: State -> Sh ()
put State
newState = do
IORef State
stateVar <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IORef a -> a -> IO ()
writeIORef IORef State
stateVar State
newState)
runCommandNoEscape :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle)
runCommandNoEscape :: [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommandNoEscape [StdHandle]
handles State
st [Char]
exe [Text]
args = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [StdHandle]
-> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
shellyProcess [StdHandle]
handles State
st forall a b. (a -> b) -> a -> b
$
[Char] -> CmdSpec
ShellCommand forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
" " ([Char] -> Text
toTextIgnore [Char]
exe forall a. a -> [a] -> [a]
: [Text]
args)
runCommand :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand :: [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand [StdHandle]
handles State
st [Char]
exe [Text]
args = [Char] -> Sh [Char]
findExe [Char]
exe forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
fullExe ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [StdHandle]
-> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
shellyProcess [StdHandle]
handles State
st forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]] -> CmdSpec
RawCommand [Char]
fullExe (forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack [Text]
args)
where
findExe :: FilePath -> Sh FilePath
findExe :: [Char] -> Sh [Char]
findExe
#if defined(mingw32_HOST_OS)
fp
#else
[Char]
_fp
#endif
= do
Either [Char] [Char]
mExe <- [Char] -> Sh (Either [Char] [Char])
whichEith [Char]
exe
case Either [Char] [Char]
mExe of
Right [Char]
execFp -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
execFp
#if defined(mingw32_HOST_OS)
Left _ -> return fp
#else
Left [Char]
err -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError [Char]
err
#endif
shellyProcess :: [StdHandle] -> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
shellyProcess :: [StdHandle]
-> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)
shellyProcess [StdHandle]
reusedHandles State
st CmdSpec
cmdSpec = do
(Maybe Handle
createdInH, Maybe Handle
createdOutH, Maybe Handle
createdErrorH, ProcessHandle
pHandle) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess {
cmdspec :: CmdSpec
cmdspec = CmdSpec
cmdSpec
, cwd :: Maybe [Char]
cwd = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ State -> [Char]
sDirectory State
st
, env :: Maybe [([Char], [Char])]
env = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ State -> [([Char], [Char])]
sEnvironment State
st
, std_in :: StdStream
std_in = Maybe StdStream -> StdStream
createUnless Maybe StdStream
mInH
, std_out :: StdStream
std_out = Maybe StdStream -> StdStream
createUnless Maybe StdStream
mOutH
, std_err :: StdStream
std_err = Maybe StdStream -> StdStream
createUnless Maybe StdStream
mErrorH
, close_fds :: Bool
close_fds = Bool
False
, create_group :: Bool
create_group = Bool
False
, delegate_ctlc :: Bool
delegate_ctlc = Bool
False
, detach_console :: Bool
detach_console = Bool
False
, create_new_console :: Bool
create_new_console = Bool
False
, new_session :: Bool
new_session = Bool
False
, child_group :: Maybe GroupID
child_group = forall a. Maybe a
Nothing
, child_user :: Maybe UserID
child_user = forall a. Maybe a
Nothing
#if MIN_VERSION_process(1,5,0)
, use_process_jobs :: Bool
use_process_jobs = Bool
False
#endif
}
forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a -> a
just forall a b. (a -> b) -> a -> b
$ Maybe Handle
createdInH forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StdStream -> Maybe Handle
toHandle Maybe StdStream
mInH
, forall a. Maybe a -> a
just forall a b. (a -> b) -> a -> b
$ Maybe Handle
createdOutH forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StdStream -> Maybe Handle
toHandle Maybe StdStream
mOutH
, forall a. Maybe a -> a
just forall a b. (a -> b) -> a -> b
$ Maybe Handle
createdErrorH forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StdStream -> Maybe Handle
toHandle Maybe StdStream
mErrorH
, ProcessHandle
pHandle
)
where
just :: Maybe a -> a
just :: forall a. Maybe a -> a
just Maybe a
Nothing = forall a. HasCallStack => [Char] -> a
error [Char]
"error in shelly creating process"
just (Just a
j) = a
j
toHandle :: Maybe StdStream -> Maybe Handle
toHandle (Just (UseHandle Handle
h)) = forall a. a -> Maybe a
Just Handle
h
toHandle (Just StdStream
CreatePipe) = forall a. HasCallStack => [Char] -> a
error [Char]
"shelly process creation failure CreatePipe"
toHandle (Just StdStream
Inherit) = forall a. HasCallStack => [Char] -> a
error [Char]
"cannot access an inherited pipe"
toHandle (Just StdStream
NoStream) = forall a. HasCallStack => [Char] -> a
error [Char]
"shelly process creation failure NoStream"
toHandle Maybe StdStream
Nothing = forall a. HasCallStack => [Char] -> a
error [Char]
"error in shelly creating process"
createUnless :: Maybe StdStream -> StdStream
createUnless Maybe StdStream
Nothing = StdStream
CreatePipe
createUnless (Just StdStream
stream) = StdStream
stream
mInH :: Maybe StdStream
mInH = (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream StdHandle -> Maybe StdStream
mIn [StdHandle]
reusedHandles
mOutH :: Maybe StdStream
mOutH = (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream StdHandle -> Maybe StdStream
mOut [StdHandle]
reusedHandles
mErrorH :: Maybe StdStream
mErrorH = (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream StdHandle -> Maybe StdStream
mError [StdHandle]
reusedHandles
getStream :: (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream :: (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream
getStream StdHandle -> Maybe StdStream
_ [] = forall a. Maybe a
Nothing
getStream StdHandle -> Maybe StdStream
mHandle (StdHandle
h:[StdHandle]
hs) = StdHandle -> Maybe StdStream
mHandle StdHandle
h 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) = forall a. a -> Maybe a
Just StdStream
h
mIn StdHandle
_ = forall a. Maybe a
Nothing
mOut :: StdHandle -> Maybe StdStream
mOut (OutHandle StdStream
h) = forall a. a -> Maybe a
Just StdStream
h
mOut StdHandle
_ = forall a. Maybe a
Nothing
mError :: StdHandle -> Maybe StdStream
mError (ErrorHandle StdStream
h) = forall a. a -> Maybe a
Just StdStream
h
mError StdHandle
_ = forall a. Maybe a
Nothing
catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a
catch_sh :: forall e a. Exception e => Sh a -> (e -> Sh a) -> Sh a
catch_sh Sh a
action e -> Sh a
handler = do
IORef State
ref <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall a. Sh a -> IORef State -> IO a
runSh Sh a
action IORef State
ref) (\e
e -> 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 :: forall e a. Exception e => (e -> Sh a) -> Sh a -> Sh a
handle_sh e -> Sh a
handler Sh a
action = do
IORef State
ref <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\e
e -> forall a. Sh a -> IORef State -> IO a
runSh (e -> Sh a
handler e
e) IORef State
ref) (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 :: forall a b. Sh a -> Sh b -> Sh a
finally_sh Sh a
action Sh b
handler = do
IORef State
ref <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IO a -> IO b -> IO a
finally (forall a. Sh a -> IORef State -> IO a
runSh Sh a
action IORef State
ref) (forall a. Sh a -> IORef State -> IO a
runSh Sh b
handler IORef State
ref)
bracket_sh :: Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
bracket_sh :: forall a b c. Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
bracket_sh Sh a
acquire a -> Sh b
release a -> Sh c
main = do
IORef State
ref <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Sh a -> IORef State -> IO a
runSh Sh a
acquire IORef State
ref)
(\a
resource -> forall a. Sh a -> IORef State -> IO a
runSh (a -> Sh b
release a
resource) IORef State
ref)
(\a
resource -> 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 :: forall a. Sh a -> [ShellyHandler a] -> Sh a
catches_sh Sh a
action [ShellyHandler a]
handlers = do
IORef State
ref <- forall r (m :: * -> *). MonadReader r m => m r
ask
let runner :: Sh a -> IO a
runner Sh a
a = forall a. Sh a -> IORef State -> IO a
runSh Sh a
a IORef State
ref
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> [Handler a] -> IO a
catches (Sh a -> IO a
runner Sh a
action) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Sh a -> IO a) -> ShellyHandler a -> Handler a
toHandler Sh a -> IO a
runner) [ShellyHandler a]
handlers
where
toHandler :: (Sh a -> IO a) -> ShellyHandler a -> Handler a
toHandler :: forall a. (Sh a -> IO a) -> ShellyHandler a -> Handler a
toHandler Sh a -> IO a
runner (ShellyHandler e -> Sh a
handler) = 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 :: forall a. Sh a -> (SomeException -> Sh a) -> Sh a
catchany_sh = 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 :: forall a. (SomeException -> Sh a) -> Sh a -> Sh a
handleany_sh = forall e a. Exception e => (e -> Sh a) -> Sh a -> Sh a
handle_sh
cd :: FilePath -> Sh ()
cd :: [Char] -> Sh ()
cd = (Text -> Text) -> [Char] -> Sh [Char]
traceCanonicPath (Text
"cd " forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Char] -> Sh ()
cd'
where
cd' :: [Char] -> Sh ()
cd' [Char]
dir = do
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM ([Char] -> Sh Bool
test_d [Char]
dir) forall a b. (a -> b) -> a -> b
$ forall a. Text -> Sh a
errorExit forall a b. (a -> b) -> a -> b
$ Text
"not a directory: " forall a. Semigroup a => a -> a -> a
<> Text
tdir
(State -> State) -> Sh ()
modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sDirectory :: [Char]
sDirectory = [Char]
dir, sPathExecutables :: Maybe [([Char], Set [Char])]
sPathExecutables = forall a. Maybe a
Nothing }
where
tdir :: Text
tdir = [Char] -> Text
toTextIgnore [Char]
dir
chdir :: FilePath -> Sh a -> Sh a
chdir :: forall a. [Char] -> Sh a -> Sh a
chdir [Char]
dir Sh a
action = do
[Char]
d <- forall a. (State -> a) -> Sh a
gets State -> [Char]
sDirectory
[Char] -> Sh ()
cd [Char]
dir
Sh a
action forall a b. Sh a -> Sh b -> Sh a
`finally_sh` [Char] -> Sh ()
cd [Char]
d
chdir_p :: FilePath -> Sh a -> Sh a
chdir_p :: forall a. [Char] -> Sh a -> Sh a
chdir_p [Char]
d Sh a
action = [Char] -> Sh ()
mkdir_p [Char]
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. [Char] -> Sh a -> Sh a
chdir [Char]
d Sh a
action
pack :: String -> FilePath
pack :: [Char] -> [Char]
pack = forall a. a -> a
id
mv :: FilePath -> FilePath -> Sh ()
mv :: [Char] -> [Char] -> Sh ()
mv [Char]
from' [Char]
to' = do
Text -> Sh ()
trace forall a b. (a -> b) -> a -> b
$ Text
"mv " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
from' forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
to'
[Char]
from <- [Char] -> Sh [Char]
absPath [Char]
from'
Bool
from_dir <- [Char] -> Sh Bool
test_d [Char]
from
[Char]
to <- [Char] -> Sh [Char]
absPath [Char]
to'
Bool
to_dir <- [Char] -> Sh Bool
test_d [Char]
to
let to_loc :: [Char]
to_loc = if Bool -> Bool
not Bool
to_dir then [Char]
to else [Char]
to [Char] -> [Char] -> [Char]
FP.</> ([Char] -> [Char]
FP.takeFileName [Char]
from)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True ([Char] -> [Char]
takeDirectory [Char]
to_loc)
if Bool -> Bool
not Bool
from_dir
then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
renameFile [Char]
from [Char]
to_loc
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (\SomeException
e -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
forall e. e -> [Char] -> ReThrownException e
ReThrownException SomeException
e ([Char] -> [Char] -> [Char]
extraMsg [Char]
to_loc [Char]
from)
)
else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
renameDirectory [Char]
from [Char]
to_loc
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (\SomeException
e -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
forall e. e -> [Char] -> ReThrownException e
ReThrownException SomeException
e ([Char] -> [Char] -> [Char]
extraMsg [Char]
to_loc [Char]
from)
)
where
extraMsg :: String -> String -> String
extraMsg :: [Char] -> [Char] -> [Char]
extraMsg [Char]
t [Char]
f = [Char]
"during copy from: " forall a. [a] -> [a] -> [a]
++ [Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
" to: " forall a. [a] -> [a] -> [a]
++ [Char]
t
lsT :: FilePath -> Sh [Text]
lsT :: [Char] -> Sh [Text]
lsT = [Char] -> Sh [[Char]]
ls forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> Sh Text
toTextWarn
pwd :: Sh FilePath
pwd :: Sh [Char]
pwd = forall a. (State -> a) -> Sh a
gets State -> [Char]
sDirectory forall a. Sh a -> Text -> Sh a
`tag` Text
"pwd"
exit :: Int -> Sh a
exit :: forall a. Int -> Sh a
exit Int
0 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO a
exitSuccess forall a. Sh a -> Text -> Sh a
`tag` Text
"exit 0"
exit Int
n = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
n)) forall a. Sh a -> Text -> Sh a
`tag` (Text
"exit " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
n))
errorExit :: Text -> Sh a
errorExit :: forall a. Text -> Sh a
errorExit Text
msg = Text -> Sh ()
echo Text
msg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Int -> Sh a
exit Int
1
quietExit :: Int -> Sh a
quietExit :: forall a. Int -> Sh a
quietExit Int
0 = forall a. Int -> Sh a
exit Int
0
quietExit Int
n = forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ Int -> QuietExit
QuietExit Int
n
terror :: Text -> Sh a
terror :: forall a. Text -> Sh a
terror = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
mkdir :: FilePath -> Sh ()
mkdir :: [Char] -> Sh ()
mkdir = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"mkdir " forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False
mkdir_p :: FilePath -> Sh ()
mkdir_p :: [Char] -> Sh ()
mkdir_p = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"mkdir -p " forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True
mkdirTree :: Tree FilePath -> Sh ()
mkdirTree :: Tree [Char] -> Sh ()
mkdirTree = Tree [Char] -> Sh ()
mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree [Char] -> Tree [Char]
unrollPath
where mk :: Tree FilePath -> Sh ()
mk :: Tree [Char] -> Sh ()
mk (Node [Char]
a [Tree [Char]]
ts) = do
Bool
b <- [Char] -> Sh Bool
test_d [Char]
a
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b forall a b. (a -> b) -> a -> b
$ [Char] -> Sh ()
mkdir [Char]
a
forall a. [Char] -> Sh a -> Sh a
chdir [Char]
a forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Tree [Char] -> Sh ()
mkdirTree [Tree [Char]]
ts
unrollPath :: Tree FilePath -> Tree FilePath
unrollPath :: Tree [Char] -> Tree [Char]
unrollPath (Node [Char]
v [Tree [Char]]
ts) = [Char] -> [Tree [Char]] -> Tree [Char]
unrollRoot [Char]
v forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Tree [Char] -> Tree [Char]
unrollPath [Tree [Char]]
ts
where unrollRoot :: [Char] -> [Tree [Char]] -> Tree [Char]
unrollRoot [Char]
x = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall {m :: * -> *} {b} {c} {a}.
Monad m =>
(m b -> c) -> (a -> b) -> a -> c
phi forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> [Tree a] -> Tree a
Node forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
splitDirectories [Char]
x
phi :: (m b -> c) -> (a -> b) -> a -> c
phi m b -> c
a a -> b
b = m b -> c
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
b
isExecutable :: FilePath -> IO Bool
isExecutable :: [Char] -> IO Bool
isExecutable [Char]
f = (Permissions -> Bool
executable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO Permissions
getPermissions [Char]
f) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOError
_ :: IOError) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
which :: FilePath -> Sh (Maybe FilePath)
which :: [Char] -> Sh (Maybe [Char])
which [Char]
fp = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Sh (Either [Char] [Char])
whichEith [Char]
fp
whichEith :: FilePath -> Sh (Either String FilePath)
whichEith :: [Char] -> Sh (Either [Char] [Char])
whichEith [Char]
originalFp = [Char] -> Sh (Either [Char] [Char])
whichFull
#if defined(mingw32_HOST_OS)
$ case takeExtension originalFp of
"" -> originalFp <.> "exe"
_ -> originalFp
#else
[Char]
originalFp
#endif
where
whichFull :: [Char] -> Sh (Either [Char] [Char])
whichFull [Char]
fp = do
(Text -> Sh ()
trace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend Text
"which " forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
toTextIgnore) [Char]
fp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh (Either [Char] [Char])
whichUntraced
where
whichUntraced :: Sh (Either [Char] [Char])
whichUntraced | [Char] -> Bool
isAbsolute [Char]
fp = Sh (Either [Char] [Char])
checkFile
| forall {a}. (Eq a, IsString a) => [a] -> Bool
startsWithDot [[Char]]
splitOnDirs = Sh (Either [Char] [Char])
checkFile
| Bool
otherwise = Sh (Maybe [Char])
lookupPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe [Char] -> Sh (Either [Char] [Char])
leftPathError
splitOnDirs :: [[Char]]
splitOnDirs = [Char] -> [[Char]]
splitDirectories [Char]
fp
startsWithDot :: [a] -> Bool
startsWithDot (a
".":[a]
_) = Bool
True
startsWithDot [a]
_ = Bool
False
checkFile :: Sh (Either String FilePath)
checkFile :: Sh (Either [Char] [Char])
checkFile = do
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
fp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
exists then forall a b. b -> Either a b
Right [Char]
fp else
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"did not find file: " forall a. Semigroup a => a -> a -> a
<> [Char]
fp
leftPathError :: Maybe FilePath -> Sh (Either String FilePath)
leftPathError :: Maybe [Char] -> Sh (Either [Char] [Char])
leftPathError Maybe [Char]
Nothing = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh [Char]
pathLookupError
leftPathError (Just [Char]
x) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [Char]
x
pathLookupError :: Sh String
pathLookupError :: Sh [Char]
pathLookupError = do
Text
pATH <- Text -> Sh Text
get_env_text Text
"PATH"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
[Char]
"shelly did not find " forall a. Monoid a => a -> a -> a
`mappend` [Char]
fp forall a. Monoid a => a -> a -> a
`mappend`
[Char]
" in the PATH: " forall a. Monoid a => a -> a -> a
`mappend` Text -> [Char]
T.unpack Text
pATH
lookupPath :: Sh (Maybe FilePath)
lookupPath :: Sh (Maybe [Char])
lookupPath = (Sh [[Char]]
pathDirs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM forall a b. (a -> b) -> a -> b
$ \[Char]
dir -> do
let fullFp :: [Char]
fullFp = [Char]
dir forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</> [Char]
fp
Bool
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
isExecutable [Char]
fullFp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
res then forall a. a -> Maybe a
Just [Char]
fullFp else forall a. Maybe a
Nothing
pathDirs :: Sh [[Char]]
pathDirs = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> Sh [Char]
absPath forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
searchPathSeparator)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> Sh Text
get_env_text Text
"PATH")
findMapM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM a -> m (Maybe b)
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return 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 (forall a. Maybe a -> Bool
isJust Maybe b
mb)
then forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
mb
else 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 :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM m Bool
c m ()
a = m Bool
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
res -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
res m ()
a
test_e :: FilePath -> Sh Bool
test_e :: [Char] -> Sh Bool
test_e = [Char] -> Sh [Char]
absPath forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
f ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Bool
file <- [Char] -> IO Bool
doesFileExist [Char]
f
if Bool
file then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else [Char] -> IO Bool
doesDirectoryExist [Char]
f
test_f :: FilePath -> Sh Bool
test_f :: [Char] -> Sh Bool
test_f = [Char] -> Sh [Char]
absPath forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO Bool
doesFileExist
test_px :: FilePath -> Sh Bool
test_px :: [Char] -> Sh Bool
test_px [Char]
exe = do
Maybe [Char]
mFull <- [Char] -> Sh (Maybe [Char])
which [Char]
exe
case Maybe [Char]
mFull of
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just [Char]
full -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
isExecutable [Char]
full
rm_rf :: FilePath -> Sh ()
rm_rf :: [Char] -> Sh ()
rm_rf [Char]
infp = do
[Char]
f <- (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"rm -rf " forall a. Semigroup a => a -> a -> a
<>) [Char]
infp
Bool
isDir <- ([Char] -> Sh Bool
test_d [Char]
f)
if Bool -> Bool
not Bool
isDir then forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ([Char] -> Sh Bool
test_f [Char]
f) forall a b. (a -> b) -> a -> b
$ [Char] -> Sh ()
rm_f [Char]
f
else
(forall a. IO a -> Sh ()
liftIO_ forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeDirectoryRecursive [Char]
f) forall e a. Exception e => Sh a -> (e -> Sh a) -> Sh a
`catch_sh` (\(IOError
e :: IOError) ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IOError -> Bool
isPermissionError IOError
e) forall a b. (a -> b) -> a -> b
$ do
[Char] -> Sh [[Char]]
find [Char]
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Char]
file -> forall a. IO a -> Sh ()
liftIO_ forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. MonadIO m => [Char] -> m ()
fixPermissions [Char]
file forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` \SomeException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeDirectoryRecursive [Char]
f
)
where fixPermissions :: [Char] -> m ()
fixPermissions [Char]
file =
do Permissions
permissions <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Permissions
getPermissions [Char]
file
let deletable :: Permissions
deletable = Permissions
permissions { readable :: Bool
readable = Bool
True, writable :: Bool
writable = Bool
True, executable :: Bool
executable = Bool
True }
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> Permissions -> IO ()
setPermissions [Char]
file Permissions
deletable
rm_f :: FilePath -> Sh ()
rm_f :: [Char] -> Sh ()
rm_f = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"rm -f " forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
f ->
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ([Char] -> Sh Bool
test_e [Char]
f) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeFile [Char]
f
rm :: FilePath -> Sh ()
rm :: [Char] -> Sh ()
rm = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"rm " forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
removeFile
setenv :: Text -> Text -> Sh ()
setenv :: Text -> Text -> Sh ()
setenv Text
k Text
v = if Text
k 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 forall a b. (a -> b) -> a -> b
$ \State
x -> State
x { sEnvironment :: [([Char], [Char])]
sEnvironment = [([Char], [Char])] -> [([Char], [Char])]
wibble forall a b. (a -> b) -> a -> b
$ State -> [([Char], [Char])]
sEnvironment State
x }
where
normK :: Text
normK = Text -> Text
normalizeEnvVarNameText Text
k
([Char]
kStr, [Char]
vStr) = (Text -> [Char]
T.unpack Text
normK, Text -> [Char]
T.unpack Text
v)
wibble :: [([Char], [Char])] -> [([Char], [Char])]
wibble [([Char], [Char])]
environment = ([Char]
kStr, [Char]
vStr) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=[Char]
kStr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [([Char], [Char])]
environment
setPath :: Text -> Sh ()
setPath :: Text -> Sh ()
setPath Text
newPath = do
(State -> State) -> Sh ()
modify forall a b. (a -> b) -> a -> b
$ \State
x -> State
x{ sPathExecutables :: Maybe [([Char], Set [Char])]
sPathExecutables = 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 :: [Char] -> Sh ()
appendToPath = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"appendToPath: " forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
filepath -> do
Text
tp <- [Char] -> Sh Text
toTextWarn [Char]
filepath
Text
pe <- Text -> Sh Text
get_env_text Text
path_env
Text -> Sh ()
setPath forall a b. (a -> b) -> a -> b
$ Text
pe forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
searchPathSeparator forall a. Semigroup a => a -> a -> a
<> Text
tp
prependToPath :: FilePath -> Sh ()
prependToPath :: [Char] -> Sh ()
prependToPath = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"prependToPath: " forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
filepath -> do
Text
tp <- [Char] -> Sh Text
toTextWarn [Char]
filepath
Text
pe <- Text -> Sh Text
get_env_text Text
path_env
Text -> Sh ()
setPath forall a b. (a -> b) -> a -> b
$ Text
tp forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
searchPathSeparator forall a. Semigroup a => a -> a -> a
<> Text
pe
get_environment :: Sh [(String, String)]
get_environment :: Sh [([Char], [Char])]
get_environment = forall a. (State -> a) -> Sh a
gets State -> [([Char], [Char])]
sEnvironment
{-# DEPRECATED get_environment "use get_env_all" #-}
get_env_all :: Sh [(String, String)]
get_env_all :: Sh [([Char], [Char])]
get_env_all = forall a. (State -> a) -> Sh a
gets State -> [([Char], [Char])]
sEnvironment
normalizeEnvVarNameText :: Text -> Text
#if defined(mingw32_HOST_OS)
normalizeEnvVarNameText = T.toLower
#else
normalizeEnvVarNameText :: Text -> Text
normalizeEnvVarNameText = 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 <- forall (m :: * -> *) a. Monad m => a -> m a
return
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> [Char]
T.unpack Text
normK)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. (State -> a) -> Sh a
gets State -> [([Char], [Char])]
sEnvironment
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Text
mval of
Maybe Text
Nothing -> forall a. Maybe a
Nothing
Just Text
val -> if (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
val) then forall a. a -> Maybe a
Just Text
val else 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 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 :: forall a. StdInit -> Sh a -> Sh a
onCommandHandles StdInit
initHandles Sh a
a =
forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
x -> State
x { sInitCommandHandles :: StdInit
sInitCommandHandles = StdInit
initHandles }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a
silently :: Sh a -> Sh a
silently :: forall a. Sh a -> Sh a
silently Sh a
a = forall a. Sh a -> Sh a
sub 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
}) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a
verbosely :: Sh a -> Sh a
verbosely :: forall a. Sh a -> Sh a
verbosely Sh a
a = forall a. Sh a -> Sh a
sub 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
}) 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 :: forall a. (Text -> IO ()) -> Sh a -> Sh a
log_stdout_with Text -> IO ()
logger Sh a
a = forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
s -> State
s { sPutStdout :: Text -> IO ()
sPutStdout = Text -> IO ()
logger })
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 :: forall a. (Text -> IO ()) -> Sh a -> Sh a
log_stderr_with Text -> IO ()
logger Sh a
a = forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
s -> State
s { sPutStderr :: Text -> IO ()
sPutStderr = Text -> IO ()
logger })
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a
print_stdout :: Bool -> Sh a -> Sh a
print_stdout :: forall a. Bool -> Sh a -> Sh a
print_stdout Bool
shouldPrint Sh a
a =
forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
x -> State
x { sPrintStdout :: Bool
sPrintStdout = Bool
shouldPrint }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a
print_stderr :: Bool -> Sh a -> Sh a
print_stderr :: forall a. Bool -> Sh a -> Sh a
print_stderr Bool
shouldPrint Sh a
a =
forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
x -> State
x { sPrintStderr :: Bool
sPrintStderr = Bool
shouldPrint }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a
print_commands :: Bool -> Sh a -> Sh a
print_commands :: forall a. Bool -> Sh a -> Sh a
print_commands Bool
shouldPrint Sh a
a = forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify (\State
st -> State
st { sPrintCommands :: Bool
sPrintCommands = Bool
shouldPrint }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh a
a
sub :: Sh a -> Sh a
sub :: forall a. Sh a -> Sh a
sub Sh a
a = do
State
oldState <- Sh State
get
(State -> State) -> Sh ()
modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sTrace :: Text
sTrace = Text
T.empty }
Sh a
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 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 :: forall a. Bool -> Sh a -> Sh a
tracing Bool
shouldTrace Sh a
action = forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ do
(State -> State) -> Sh ()
modify 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 :: forall a. Bool -> Sh a -> Sh a
escaping Bool
shouldEscape Sh a
action = forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ do
(State -> State) -> Sh ()
modify 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 :: forall a. Bool -> Sh a -> Sh a
errExit Bool
shouldExit Sh a
action = forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ do
(State -> State) -> Sh ()
modify 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 :: forall a. Bool -> Sh a -> Sh a
followSymlink Bool
enableFollowSymlink Sh a
action = forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ do
(State -> State) -> Sh ()
modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sFollowSymlink :: Bool
sFollowSymlink = Bool
enableFollowSymlink }
Sh a
action
defReadOnlyState :: ReadOnlyState
defReadOnlyState :: ReadOnlyState
defReadOnlyState = ReadOnlyState { rosFailToDir :: Bool
rosFailToDir = Bool
False }
shellyNoDir :: MonadIO m => Sh a -> m a
shellyNoDir :: forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shellyNoDir = forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState { rosFailToDir :: Bool
rosFailToDir = Bool
False }
{-# DEPRECATED shellyNoDir "Just use shelly. The default settings have changed" #-}
shellyFailDir :: MonadIO m => Sh a -> m a
shellyFailDir :: forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shellyFailDir = forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState { rosFailToDir :: Bool
rosFailToDir = Bool
True }
getNormalizedEnvironment :: IO [(String, String)]
getNormalizedEnvironment :: IO [([Char], [Char])]
getNormalizedEnvironment =
#if defined(mingw32_HOST_OS)
fmap (\(a, b) -> (map toLower a, b)) <$> getEnvironment
#else
IO [([Char], [Char])]
getEnvironment
#endif
shelly :: MonadIO m => Sh a -> m a
shelly :: forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly = forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState
defReadOnlyState
shelly' :: MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' :: forall (m :: * -> *) a. MonadIO m => ReadOnlyState -> Sh a -> m a
shelly' ReadOnlyState
ros Sh a
action = do
[([Char], [Char])]
environment <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [([Char], [Char])]
getNormalizedEnvironment
[Char]
dir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getCurrentDirectory
let def :: State
def = State { sCode :: Int
sCode = Int
0
, sStdin :: Maybe Text
sStdin = 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 (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
, sCommandEscaping :: Bool
sCommandEscaping = Bool
True
, sEnvironment :: [([Char], [Char])]
sEnvironment = [([Char], [Char])]
environment
, sTracing :: Bool
sTracing = Bool
True
, sTrace :: Text
sTrace = Text
T.empty
, sDirectory :: [Char]
sDirectory = [Char]
dir
, sPathExecutables :: Maybe [([Char], Set [Char])]
sPathExecutables = forall a. Maybe a
Nothing
, sErrExit :: Bool
sErrExit = Bool
True
, sReadOnly :: ReadOnlyState
sReadOnly = ReadOnlyState
ros
, sFollowSymlink :: Bool
sFollowSymlink = Bool
False
}
IORef State
stref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef State
def
let caught :: Sh a
caught =
Sh a
action forall a. Sh a -> [ShellyHandler a] -> Sh a
`catches_sh` [
forall a e. Exception e => (e -> Sh a) -> ShellyHandler a
ShellyHandler (\ExitCode
ex ->
case ExitCode
ex of
ExitCode
ExitSuccess -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO ExitCode
ex
ExitFailure Int
_ -> forall exception a. Exception exception => exception -> Sh a
throwExplainedException ExitCode
ex
)
, forall a e. Exception e => (e -> Sh a) -> ShellyHandler a
ShellyHandler (\QuietExit
ex -> case QuietExit
ex of
QuietExit Int
n -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
n)
, forall a e. Exception e => (e -> Sh a) -> ShellyHandler a
ShellyHandler (\(SomeException
ex::SomeException) -> forall exception a. Exception exception => exception -> Sh a
throwExplainedException SomeException
ex)
]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Sh a -> IORef State -> IO a
runSh Sh a
caught IORef State
stref
where
throwExplainedException :: Exception exception => exception -> Sh a
throwExplainedException :: forall exception a. Exception exception => exception -> Sh a
throwExplainedException exception
ex = Sh State
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State -> Sh [Char]
errorMsg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. e -> [Char] -> ReThrownException e
ReThrownException exception
ex
errorMsg :: State -> Sh [Char]
errorMsg State
st =
if Bool -> Bool
not (ReadOnlyState -> Bool
rosFailToDir forall a b. (a -> b) -> a -> b
$ State -> ReadOnlyState
sReadOnly State
st) then Sh [Char]
ranCommands else do
[Char]
d <- Sh [Char]
pwd
[Char]
sf <- Sh [Char]
shellyFile
let logFile :: [Char]
logFile = [Char]
dforall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</>[Char]
shelly_dirforall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</>[Char]
sf
([Char] -> Text -> Sh ()
writefile [Char]
logFile Text
trc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
"log of commands saved to: " forall a. Semigroup a => a -> a -> a
<> [Char]
logFile))
forall a. Sh a -> (SomeException -> Sh a) -> Sh a
`catchany_sh` (\SomeException
_ -> Sh [Char]
ranCommands)
where
trc :: Text
trc = State -> Text
sTrace State
st
ranCommands :: Sh [Char]
ranCommands = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend [Char]
"Ran commands: \n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Text
trc
shelly_dir :: [Char]
shelly_dir = [Char]
".shelly"
shellyFile :: Sh [Char]
shellyFile = forall a. [Char] -> Sh a -> Sh a
chdir_p [Char]
shelly_dir forall a b. (a -> b) -> a -> b
$ do
[[Char]]
fs <- [Char] -> Sh [[Char]]
ls [Char]
"."
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show ([[Char]] -> Int
nextNum [[Char]]
fs) forall a. Semigroup a => a -> a -> a
<> [Char]
".txt"
nextNum :: [FilePath] -> Int
nextNum :: [[Char]] -> Int
nextNum [] = Int
1
nextNum [[Char]]
fs = (forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Read a => a -> [Char] -> a
readDef Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeFileName) forall a b. (a -> b) -> a -> b
$ [[Char]]
fs
readDef :: Read a => a -> String -> a
readDef :: forall a. Read a => a -> [Char] -> a
readDef a
def = forall a. a -> Maybe a -> a
fromMaybe a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> Maybe a
readMay
where
readMay :: Read a => String -> Maybe a
readMay :: forall a. Read a => [Char] -> Maybe a
readMay [Char]
s = case [a
x | (a
x,[Char]
t) <- forall a. Read a => ReadS a
reads [Char]
s, ([Char]
"",[Char]
"") <- ReadS [Char]
lex [Char]
t] of
[a
x] -> forall a. a -> Maybe a
Just a
x
[a]
_ -> forall a. Maybe a
Nothing
data RunFailed = RunFailed FilePath [Text] Int Text deriving (Typeable)
instance Show RunFailed where
show :: RunFailed -> [Char]
show (RunFailed [Char]
exe [Text]
args Int
code Text
errs) =
let codeMsg :: [Char]
codeMsg = case Int
code of
Int
127 -> [Char]
". exit code 127 usually means the command does not exist (in the PATH)"
Int
_ -> [Char]
""
in [Char]
"error running: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack ([Char] -> [Text] -> Text
show_command [Char]
exe [Text]
args) forall a. [a] -> [a] -> [a]
++
[Char]
"\nexit status: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
code forall a. [a] -> [a] -> [a]
++ [Char]
codeMsg forall a. [a] -> [a] -> [a]
++ [Char]
"\nstderr: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
errs
instance Exception RunFailed
show_command :: FilePath -> [Text] -> Text
show_command :: [Char] -> [Text] -> Text
show_command [Char]
exe [Text]
args =
let escape :: Char -> Text
escape Char
char | Char
char forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
specialsInQuotes = [Char] -> Text
T.pack [Char
'\\', Char
char]
escape Char
char = Char -> Text
T.singleton Char
char
quote :: Text -> Text
quote Text
arg = Char -> Text -> Text
surround Char
'"' forall a b. (a -> b) -> a -> b
$ (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escape Text
arg
isSafe :: Char -> Bool
isSafe Char
c = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a b. (a -> b) -> a -> b
$ Char
c) [Char -> Bool
isPrint, Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace, (forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Char
specials)]
showArg :: Text -> Text
showArg Text
"" = Char -> Text -> Text
surround Char
'"' Text
""
showArg Text
arg | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSafe Text
arg = Text
arg
showArg Text
arg = Text -> Text
quote Text
arg
in Text -> [Text] -> Text
T.intercalate Text
" " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
showArg ([Char] -> Text
toTextIgnore [Char]
exe forall a. a -> [a] -> [a]
: [Text]
args)
specials :: Set.Set Char
specials :: Set Char
specials = forall a. Ord a => [a] -> Set a
Set.fromList [Char]
"\\'\"`$&|;(){}<>"
specialsInQuotes :: Set.Set Char
specialsInQuotes :: Set Char
specialsInQuotes = forall a. Ord a => [a] -> Set a
Set.fromList [Char]
"\\\"`$"
quoteOne :: Text -> Text
quoteOne :: Text -> Text
quoteOne Text
t =
Char -> Text -> Text
surround Char
'\'' forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
"'" Text
"'\\''" Text
t
quoteCommand :: FilePath -> [Text] -> Text
quoteCommand :: [Char] -> [Text] -> Text
quoteCommand [Char]
exe [Text]
args =
Text -> [Text] -> Text
T.intercalate Text
" " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quoteOne ([Char] -> Text
toTextIgnore [Char]
exe 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 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 -> [([Char], [Text])] -> Sh ()
sshPairs_ Text
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
sshPairs_ Text
server [([Char], [Text])]
cmds = forall a.
([Char] -> [Text] -> Sh a) -> Text -> [([Char], [Text])] -> Sh a
sshPairs' [Char] -> [Text] -> Sh ()
run_ Text
server [([Char], [Text])]
cmds
sshPairsPar_ :: Text -> [(FilePath, [Text])] -> Sh ()
sshPairsPar_ :: Text -> [([Char], [Text])] -> Sh ()
sshPairsPar_ Text
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
sshPairsPar_ Text
server [([Char], [Text])]
cmds = forall a.
([Char] -> [Text] -> Sh a) -> Text -> [([Char], [Text])] -> Sh a
sshPairsPar' [Char] -> [Text] -> Sh ()
run_ Text
server [([Char], [Text])]
cmds
sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text
sshPairs :: Text -> [([Char], [Text])] -> Sh Text
sshPairs Text
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairs Text
server [([Char], [Text])]
cmds = forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh Text
run Text
server [] [([Char], [Text])]
cmds SshMode
SeqSsh
sshPairsPar :: Text -> [(FilePath, [Text])] -> Sh Text
sshPairsPar :: Text -> [([Char], [Text])] -> Sh Text
sshPairsPar Text
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairsPar Text
server [([Char], [Text])]
cmds = forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh Text
run Text
server [] [([Char], [Text])]
cmds SshMode
ParSsh
sshPairsPar' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
sshPairsPar' :: forall a.
([Char] -> [Text] -> Sh a) -> Text -> [([Char], [Text])] -> Sh a
sshPairsPar' [Char] -> [Text] -> Sh a
run' Text
server [([Char], [Text])]
actions = forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh a
run' Text
server [] [([Char], [Text])]
actions SshMode
ParSsh
sshPairs' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a
sshPairs' :: forall a.
([Char] -> [Text] -> Sh a) -> Text -> [([Char], [Text])] -> Sh a
sshPairs' [Char] -> [Text] -> Sh a
run' Text
server [([Char], [Text])]
actions = forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh a
run' Text
server [] [([Char], [Text])]
actions SshMode
SeqSsh
sshPairsWithOptions :: Text
-> [Text]
-> [(FilePath, [Text])]
-> Sh Text
sshPairsWithOptions :: Text -> [Text] -> [([Char], [Text])] -> Sh Text
sshPairsWithOptions Text
_ [Text]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
sshPairsWithOptions Text
server [Text]
sshargs [([Char], [Text])]
cmds = forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh Text
run Text
server [Text]
sshargs [([Char], [Text])]
cmds SshMode
SeqSsh
sshPairsWithOptions' :: (FilePath -> [Text] -> Sh a) -> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh a
sshPairsWithOptions' :: forall a.
([Char] -> [Text] -> Sh a)
-> Text -> [Text] -> [([Char], [Text])] -> SshMode -> Sh a
sshPairsWithOptions' [Char] -> [Text] -> Sh a
run' Text
server [Text]
sshargs [([Char], [Text])]
actions SshMode
mode = forall a. Bool -> Sh a -> Sh a
escaping Bool
False forall a b. (a -> b) -> a -> b
$ do
[Char] -> [Text] -> Sh a
run' [Char]
"ssh" ([Text
server] forall a. [a] -> [a] -> [a]
++ [Text]
sshargs forall a. [a] -> [a] -> [a]
++ [[([Char], [Text])] -> SshMode -> Text
sshCommandText [([Char], [Text])]
actions SshMode
mode])
sshCommandText :: [(FilePath, [Text])] -> SshMode -> Text
sshCommandText :: [([Char], [Text])] -> SshMode -> Text
sshCommandText [([Char], [Text])]
actions SshMode
mode =
Text -> Text
quoteOne (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Text -> Text -> Text
joiner (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> [Text] -> Text
quoteCommand) [([Char], [Text])]
actions))
where
joiner :: Text -> Text -> Text
joiner Text
memo Text
next = case SshMode
mode of
SshMode
SeqSsh -> Text
memo forall a. Semigroup a => a -> a -> a
<> Text
" && " forall a. Semigroup a => a -> a -> a
<> Text
next
SshMode
ParSsh -> Text
memo forall a. Semigroup a => a -> a -> a
<> Text
" & " forall a. Semigroup a => a -> a -> a
<> Text
next
data QuietExit = QuietExit Int deriving (Int -> QuietExit -> [Char] -> [Char]
[QuietExit] -> [Char] -> [Char]
QuietExit -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [QuietExit] -> [Char] -> [Char]
$cshowList :: [QuietExit] -> [Char] -> [Char]
show :: QuietExit -> [Char]
$cshow :: QuietExit -> [Char]
showsPrec :: Int -> QuietExit -> [Char] -> [Char]
$cshowsPrec :: Int -> QuietExit -> [Char] -> [Char]
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 -> [Char]
show (ReThrownException e
ex [Char]
msg) = [Char]
"\n" forall a. [a] -> [a] -> [a]
++
[Char]
msg forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ [Char]
"Exception: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show e
ex
run :: FilePath -> [Text] -> Sh Text
run :: [Char] -> [Text] -> Sh Text
run [Char]
fp [Text]
args = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> Text
lineSeqToText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. a -> FoldCallback a -> [Char] -> [Text] -> Sh a
runFoldLines forall a. Monoid a => a
mempty forall a. Seq a -> a -> Seq a
(|>) [Char]
fp [Text]
args
bash :: FilePath -> [Text] -> Sh Text
bash :: [Char] -> [Text] -> Sh Text
bash [Char]
fp [Text]
args = forall a. Bool -> Sh a -> Sh a
escaping Bool
False forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> Sh Text
run [Char]
"bash" forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> [Text]
bashArgs [Char]
fp [Text]
args
bash_ :: FilePath -> [Text] -> Sh ()
bash_ :: [Char] -> [Text] -> Sh ()
bash_ [Char]
fp [Text]
args = forall a. Bool -> Sh a -> Sh a
escaping Bool
False forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> Sh ()
run_ [Char]
"bash" forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> [Text]
bashArgs [Char]
fp [Text]
args
bashArgs :: FilePath -> [Text] -> [Text]
bashArgs :: [Char] -> [Text] -> [Text]
bashArgs [Char]
fp [Text]
args = [Text
"-c", Text
"'" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
sanitise ([Char] -> Text
toTextIgnore [Char]
fp forall a. a -> [a] -> [a]
: [Text]
args) forall a. Semigroup a => a -> a -> a
<> Text
"'"]
where
sanitise :: [Text] -> Text
sanitise = Text -> Text -> Text -> Text
T.replace 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 :: forall a. ([Char] -> [Text] -> Sh a) -> [Char] -> [Text] -> Sh a
bashPipeFail [Char] -> [Text] -> Sh a
runner [Char]
fp [Text]
args = [Char] -> [Text] -> Sh a
runner [Char]
"set -o pipefail;" ([Char] -> Text
toTextIgnore [Char]
fp forall a. a -> [a] -> [a]
: [Text]
args)
command :: FilePath -> [Text] -> [Text] -> Sh Text
command :: [Char] -> [Text] -> [Text] -> Sh Text
command [Char]
com [Text]
args [Text]
more_args = [Char] -> [Text] -> Sh Text
run [Char]
com ([Text]
args forall a. [a] -> [a] -> [a]
++ [Text]
more_args)
command_ :: FilePath -> [Text] -> [Text] -> Sh ()
command_ :: [Char] -> [Text] -> [Text] -> Sh ()
command_ [Char]
com [Text]
args [Text]
more_args = [Char] -> [Text] -> Sh ()
run_ [Char]
com ([Text]
args forall a. [a] -> [a] -> [a]
++ [Text]
more_args)
command1 :: FilePath -> [Text] -> Text -> [Text] -> Sh Text
command1 :: [Char] -> [Text] -> Text -> [Text] -> Sh Text
command1 [Char]
com [Text]
args Text
one_arg [Text]
more_args = [Char] -> [Text] -> Sh Text
run [Char]
com ([Text]
args forall a. [a] -> [a] -> [a]
++ [Text
one_arg] forall a. [a] -> [a] -> [a]
++ [Text]
more_args)
command1_ :: FilePath -> [Text] -> Text -> [Text] -> Sh ()
command1_ :: [Char] -> [Text] -> Text -> [Text] -> Sh ()
command1_ [Char]
com [Text]
args Text
one_arg [Text]
more_args = [Char] -> [Text] -> Sh ()
run_ [Char]
com ([Text]
args forall a. [a] -> [a] -> [a]
++ [Text
one_arg] forall a. [a] -> [a] -> [a]
++ [Text]
more_args)
run_ :: FilePath -> [Text] -> Sh ()
run_ :: [Char] -> [Text] -> Sh ()
run_ [Char]
exe [Text]
args = do
State
state <- Sh State
get
if State -> Bool
sPrintStdout State
state
then Sh ()
runWithColor_
else forall a. a -> FoldCallback a -> [Char] -> [Text] -> Sh a
runFoldLines () (\()
_ Text
_ -> ()) [Char]
exe [Text]
args
where
runWithColor_ :: Sh ()
runWithColor_ =
forall a.
[Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles [Char]
exe [Text]
args [StdStream -> StdHandle
OutHandle StdStream
Inherit] forall a b. (a -> b) -> a -> b
$ \Handle
inH Handle
_ Handle
errH -> do
State
state <- Sh State
get
Text
errs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
HandleInitializer
hClose Handle
inH
Async (Seq Text)
errVar <- (forall a.
a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar forall a. Monoid a => a
mempty forall a. Seq a -> a -> Seq a
(|>) Handle
errH (State -> Text -> IO ()
sPutStderr State
state) (State -> Bool
sPrintStderr State
state))
Seq Text -> Text
lineSeqToText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Async a -> IO a
wait Async (Seq Text)
errVar
(State -> State) -> Sh ()
modify forall a b. (a -> b) -> a -> b
$ \State
state' -> State
state' { sStderr :: Text
sStderr = Text
errs }
forall (m :: * -> *) a. Monad m => a -> m a
return ()
liftIO_ :: IO a -> Sh ()
liftIO_ :: forall a. IO a -> Sh ()
liftIO_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
runHandle :: FilePath
-> [Text]
-> (Handle -> Sh a)
-> Sh a
runHandle :: forall a. [Char] -> [Text] -> (Handle -> Sh a) -> Sh a
runHandle [Char]
exe [Text]
args Handle -> Sh a
withHandle = forall a.
[Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles [Char]
exe [Text]
args [] forall a b. (a -> b) -> a -> b
$ \Handle
_ Handle
outH Handle
errH -> do
State
state <- Sh State
get
Async (Seq Text)
errVar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
(forall a.
a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar forall a. Monoid a => a
mempty 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Seq Text -> Text
lineSeqToText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Async a -> IO a
wait Async (Seq Text)
errVar
(State -> State) -> Sh ()
modify forall a b. (a -> b) -> a -> b
$ \State
state' -> State
state' { sStderr :: Text
sStderr = Text
errs }
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
runHandles
:: FilePath
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles :: forall a.
[Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles [Char]
exe [Text]
args [StdHandle]
reusedHandles Handle -> Handle -> Handle -> Sh a
withHandles = do
State
origstate <- Sh State
get
let mStdin :: Maybe Text
mStdin = State -> Maybe Text
sStdin State
origstate
State -> Sh ()
put forall a b. (a -> b) -> a -> b
$ State
origstate { sStdin :: Maybe Text
sStdin = forall a. Maybe a
Nothing, sCode :: Int
sCode = Int
0, sStderr :: Text
sStderr = Text
T.empty }
State
state <- Sh State
get
let cmdString :: Text
cmdString = [Char] -> [Text] -> Text
show_command [Char]
exe [Text]
args
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (State -> Bool
sPrintCommands State
state) forall a b. (a -> b) -> a -> b
$ Text -> Sh ()
echo Text
cmdString
Text -> Sh ()
trace Text
cmdString
let doRun :: [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
doRun = if State -> Bool
sCommandEscaping State
state then [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommand else [StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
runCommandNoEscape
forall a b c. Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
bracket_sh
([StdHandle]
-> State
-> [Char]
-> [Text]
-> Sh (Handle, Handle, Handle, ProcessHandle)
doRun [StdHandle]
reusedHandles State
state [Char]
exe [Text]
args)
(\(Handle
_,Handle
_,Handle
_,ProcessHandle
procH) -> (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ()
terminateProcess ProcessHandle
procH))
(\(Handle
inH,Handle
outH,Handle
errH,ProcessHandle
procH) -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 -> 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) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
ExitCode
ex' <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
procH
HandleInitializer
hClose Handle
outH forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
HandleInitializer
hClose Handle
errH forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
HandleInitializer
hClose Handle
inH forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return 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 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Text] -> Int -> Text -> RunFailed
RunFailed [Char]
exe [Text]
args Int
n (State -> Text
sStderr State
newState)
(Bool, ExitCode)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
result
)
runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> Sh a
runFoldLines :: forall a. a -> FoldCallback a -> [Char] -> [Text] -> Sh a
runFoldLines a
start FoldCallback a
cb [Char]
exe [Text]
args =
forall a.
[Char]
-> [Text]
-> [StdHandle]
-> (Handle -> Handle -> Handle -> Sh a)
-> Sh a
runHandles [Char]
exe [Text]
args [] 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) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
HandleInitializer
hClose Handle
inH
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
(forall a.
a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar forall a. Monoid a => a
mempty forall a. Seq a -> a -> Seq a
(|>) Handle
errH (State -> Text -> IO ()
sPutStderr State
state) (State -> Bool
sPrintStderr State
state))
(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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Seq Text -> Text
lineSeqToText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Async a -> IO a
wait Async (Seq Text)
errVar
(State -> State) -> Sh ()
modify forall a b. (a -> b) -> a -> b
$ \State
state' -> State
state' { sStderr :: Text
sStderr = Text
errs }
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Async a -> IO a
wait Async a
outVar
putHandleIntoMVar
:: a -> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar :: forall a.
a
-> FoldCallback a
-> Handle
-> (Text -> IO ())
-> Bool
-> IO (Async a)
putHandleIntoMVar a
start FoldCallback a
cb Handle
outH Text -> IO ()
putWrite Bool
shouldPrint = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ do
if Bool
shouldPrint
then forall a. a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a
transferFoldHandleLines a
start FoldCallback a
cb Handle
outH Text -> IO ()
putWrite
else forall a. a -> FoldCallback a -> Handle -> IO a
foldHandleLines a
start FoldCallback a
cb Handle
outH
lastStderr :: Sh Text
lastStderr :: Sh Text
lastStderr = forall a. (State -> a) -> Sh a
gets State -> Text
sStderr
lastExitCode :: Sh Int
lastExitCode :: Sh Int
lastExitCode = forall a. (State -> a) -> Sh a
gets State -> Int
sCode
setStdin :: Text -> Sh ()
setStdin :: Text -> Sh ()
setStdin Text
input = (State -> State) -> Sh ()
modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { sStdin :: Maybe Text
sStdin = forall a. a -> Maybe a
Just Text
input }
(-|-) :: Sh Text -> Sh b -> Sh b
Sh Text
one -|- :: forall b. Sh Text -> Sh b -> Sh b
-|- Sh b
two = do
Text
res <- 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 :: [Char] -> [Char] -> Sh ()
cp_r [Char]
from' [Char]
to' = do
[Char]
from <- [Char] -> Sh [Char]
absPath [Char]
from'
Bool
fromIsDir <- ([Char] -> Sh Bool
test_d [Char]
from)
if Bool -> Bool
not Bool
fromIsDir then Bool -> [Char] -> [Char] -> Sh ()
cp_should_follow_symlinks Bool
False [Char]
from' [Char]
to' else do
Text -> Sh ()
trace forall a b. (a -> b) -> a -> b
$ Text
"cp_r " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
from forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
to'
[Char]
to <- [Char] -> Sh [Char]
absPath [Char]
to'
Bool
toIsDir <- [Char] -> Sh Bool
test_d [Char]
to
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
from forall a. Eq a => a -> a -> Bool
== [Char]
to) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Text
"cp_r: " forall a. Semigroup a => a -> a -> a
<>
[Char] -> Text
toTextIgnore [Char]
from forall a. Semigroup a => a -> a -> a
<> Text
" and " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
to forall a. Semigroup a => a -> a -> a
<> Text
" are identical"
[Char]
finalTo <- if Bool -> Bool
not Bool
toIsDir then do
[Char] -> Sh ()
mkdir [Char]
to
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
to
else do
let d :: [Char]
d = [Char]
to forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> [Char]
</> (forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitPath forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeDirectory ([Char] -> [Char]
addTrailingPathSeparator [Char]
from))
[Char] -> Sh ()
mkdir_p [Char]
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
d
[Char] -> Sh [[Char]]
ls [Char]
from forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Char]
item -> do
[Char] -> [Char] -> Sh ()
cp_r ([Char]
from [Char] -> [Char] -> [Char]
FP.</> [Char] -> [Char]
takeFileName [Char]
item) ([Char]
finalTo [Char] -> [Char] -> [Char]
FP.</> [Char] -> [Char]
takeFileName [Char]
item))
cp :: FilePath -> FilePath -> Sh ()
cp :: [Char] -> [Char] -> Sh ()
cp = Bool -> [Char] -> [Char] -> Sh ()
cp_should_follow_symlinks Bool
True
cp_should_follow_symlinks :: Bool -> FilePath -> FilePath -> Sh ()
cp_should_follow_symlinks :: Bool -> [Char] -> [Char] -> Sh ()
cp_should_follow_symlinks Bool
shouldFollowSymlinks [Char]
from' [Char]
to' = do
[Char]
from <- [Char] -> Sh [Char]
absPath [Char]
from'
[Char]
to <- [Char] -> Sh [Char]
absPath [Char]
to'
Text -> Sh ()
trace forall a b. (a -> b) -> a -> b
$ Text
"cp " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
from forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
toTextIgnore [Char]
to
Bool
to_dir <- [Char] -> Sh Bool
test_d [Char]
to
let to_loc :: [Char]
to_loc = if Bool
to_dir then [Char]
to [Char] -> [Char] -> [Char]
FP.</> [Char] -> [Char]
takeFileName [Char]
from else [Char]
to
if Bool
shouldFollowSymlinks then forall {m :: * -> *}. MonadIO m => [Char] -> [Char] -> m ()
copyNormal [Char]
from [Char]
to_loc else do
Bool
isSymlink <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
pathIsSymbolicLink [Char]
from
if Bool -> Bool
not Bool
isSymlink then forall {m :: * -> *}. MonadIO m => [Char] -> [Char] -> m ()
copyNormal [Char]
from [Char]
to_loc else do
[Char]
target <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
getSymbolicLinkTarget [Char]
from
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
createFileLink [Char]
target [Char]
to_loc
where
extraMsg :: String -> String -> String
extraMsg :: [Char] -> [Char] -> [Char]
extraMsg [Char]
t [Char]
f = [Char]
"during copy from: " forall a. [a] -> [a] -> [a]
++ [Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
" to: " forall a. [a] -> [a] -> [a]
++ [Char]
t
copyNormal :: [Char] -> [Char] -> m ()
copyNormal [Char]
from [Char]
to = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
copyFile [Char]
from [Char]
to forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` (\SomeException
e -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
forall e. e -> [Char] -> ReThrownException e
ReThrownException SomeException
e ([Char] -> [Char] -> [Char]
extraMsg [Char]
to [Char]
from)
)
withTmpDir :: (FilePath -> Sh a) -> Sh a
withTmpDir :: forall a. ([Char] -> Sh a) -> Sh a
withTmpDir [Char] -> Sh a
act = do
Text -> Sh ()
trace Text
"withTmpDir"
[Char]
dir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getTemporaryDirectory
ThreadId
tid <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId
([Char]
pS, Handle
fhandle) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ([Char], Handle)
openTempFile [Char]
dir ([Char]
"tmp" forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum (forall a. Show a => a -> [Char]
show ThreadId
tid))
let p :: [Char]
p = [Char] -> [Char]
pack [Char]
pS
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HandleInitializer
hClose Handle
fhandle
[Char] -> Sh ()
rm_f [Char]
p
[Char] -> Sh ()
mkdir [Char]
p
[Char] -> Sh a
act [Char]
p forall a b. Sh a -> Sh b -> Sh a
`finally_sh` [Char] -> Sh ()
rm_rf [Char]
p
writefile :: FilePath -> Text -> Sh ()
writefile :: [Char] -> Text -> Sh ()
writefile [Char]
f' Text
bits = do
[Char]
f <- (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"writefile " forall a. Semigroup a => a -> a -> a
<>) [Char]
f'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> Text -> IO ()
TIO.writeFile [Char]
f Text
bits)
writeBinary :: FilePath -> ByteString -> Sh ()
writeBinary :: [Char] -> ByteString -> Sh ()
writeBinary [Char]
f' ByteString
bytes = do
[Char]
f <- (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"writeBinary " forall a. Semigroup a => a -> a -> a
<>) [Char]
f'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> ByteString -> IO ()
BS.writeFile [Char]
f ByteString
bytes)
touchfile :: FilePath -> Sh ()
touchfile :: [Char] -> Sh ()
touchfile = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"touch " forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> Text -> Sh ()
appendfile Text
""
appendfile :: FilePath -> Text -> Sh ()
appendfile :: [Char] -> Text -> Sh ()
appendfile [Char]
f' Text
bits = do
[Char]
f <- (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"appendfile " forall a. Semigroup a => a -> a -> a
<>) [Char]
f'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> Text -> IO ()
TIO.appendFile [Char]
f Text
bits)
readfile :: FilePath -> Sh Text
readfile :: [Char] -> Sh Text
readfile = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"readfile " forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \[Char]
fp ->
[Char] -> Sh ByteString
readBinary [Char]
fp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TE.lenientDecode
readBinary :: FilePath -> Sh ByteString
readBinary :: [Char] -> Sh ByteString
readBinary = (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath (Text
"readBinary " forall a. Semigroup a => a -> a -> a
<>)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ByteString
BS.readFile
hasExt :: Text -> FilePath -> Bool
hasExt :: Text -> [Char] -> Bool
hasExt Text
ext [Char]
fp = [Char] -> Text
T.pack ([Char] -> [Char]
FP.takeExtension [Char]
fp) forall a. Eq a => a -> a -> Bool
== Text
ext
time :: Sh a -> Sh (Double, a)
time :: forall a. Sh a -> Sh (Double, a)
time Sh a
what = forall a. Sh a -> Sh a
sub forall a b. (a -> b) -> a -> b
$ do
Text -> Sh ()
trace Text
"time"
UTCTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
a
res <- Sh a
what
UTCTime
t' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t' UTCTime
t, a
res)
sleep :: Int -> Sh ()
sleep :: Int -> Sh ()
sleep = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
threadDelay forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
1000 forall a. Num a => a -> a -> a
* Int
1000 forall a. Num a => a -> a -> a
*)
asyncSh :: Sh a -> Sh (Async a)
asyncSh :: forall a. Sh a -> Sh (Async a)
asyncSh Sh a
proc = do
State
state <- Sh State
get
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (State -> Sh ()
put State
state 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 :: ([Char] -> Sh [Char]) -> (Text -> Text) -> [Char] -> Sh [Char]
tracePath [Char] -> Sh [Char]
convert Text -> Text
tracer [Char]
infp =
([Char] -> Sh [Char]
convert [Char]
infp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
fp -> [Char] -> Sh ()
traceIt [Char]
fp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
fp)
forall a. Sh a -> (SomeException -> Sh a) -> Sh a
`catchany_sh` (\SomeException
e -> [Char] -> Sh ()
traceIt [Char]
infp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => e -> IO a
throwIO SomeException
e))
where traceIt :: [Char] -> Sh ()
traceIt = Text -> Sh ()
trace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tracer forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
toTextIgnore
traceAbsPath :: (Text -> Text) -> FilePath -> Sh FilePath
traceAbsPath :: (Text -> Text) -> [Char] -> Sh [Char]
traceAbsPath = ([Char] -> Sh [Char]) -> (Text -> Text) -> [Char] -> Sh [Char]
tracePath [Char] -> Sh [Char]
absPath
traceCanonicPath :: (Text -> Text) -> FilePath -> Sh FilePath
traceCanonicPath :: (Text -> Text) -> [Char] -> Sh [Char]
traceCanonicPath = ([Char] -> Sh [Char]) -> (Text -> Text) -> [Char] -> Sh [Char]
tracePath [Char] -> Sh [Char]
canonic