{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings,
FlexibleInstances, FlexibleContexts, IncoherentInstances,
TypeFamilies, ExistentialQuantification, RankNTypes,
ImpredicativeTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Shelly.Lifted
(
MonadSh(..),
MonadShControl(..),
Sh, ShIO, S.shelly, S.shellyNoDir, S.shellyFailDir, sub
, silently, verbosely, escaping, print_stdout, print_stderr, print_commands
, tracing, errExit
, log_stdout_with, log_stderr_with
, run, run_, runFoldLines, S.cmd, S.FoldCallback
, (-|-), lastStderr, setStdin, lastExitCode
, command, command_, command1, command1_
, sshPairs, sshPairs_
, S.ShellCmd(..), S.CmdArg (..)
, runHandle, runHandles, transferLinesAndCombine, S.transferFoldHandleLines
, S.StdHandle(..), S.StdStream(..)
, setenv, get_env, get_env_text, get_env_all, appendToPath, prependToPath
, cd, chdir, chdir_p, pwd
, echo, echo_n, echo_err, echo_n_err, inspect, inspect_err
, tag, trace, S.show_command
, ls, lsT, test_e, test_f, test_d, test_s, test_px, which
, absPath, (S.</>), (S.<.>), canonic, canonicalize, relPath, relativeTo
, S.hasExt
, mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree
, readfile, readBinary, writefile, appendfile, touchfile, withTmpDir
, exit, errorExit, quietExit, terror
, bracket_sh, catchany, catch_sh, handle_sh, handleany_sh, finally_sh, catches_sh, catchany_sh
, S.toTextIgnore, toTextWarn, S.fromText
, S.whenM, S.unlessM, time, sleep
, liftIO, S.when, S.unless, FilePath, (S.<$>)
, Shelly.Lifted.get, Shelly.Lifted.put
, S.find, S.findWhen, S.findFold, S.findDirFilter, S.findDirFilterWhen, S.findFoldDirFilter
, followSymlink
) where
import qualified Shelly as S
import Shelly.Base (Sh(..), ShIO, Text, (>=>), FilePath)
import qualified Shelly.Base as S
import Control.Monad ( liftM )
import Prelude hiding ( FilePath )
import Data.ByteString ( ByteString )
import Data.Monoid
import System.IO ( Handle )
import Data.Tree ( Tree )
import qualified System.FilePath as FP
import Control.Exception.Lifted
import Control.Exception.Enclosed
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import Control.Monad.Trans.Identity
import Control.Monad.Trans.List
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Error
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import qualified Control.Monad.Trans.State.Strict as Strict
import Control.Monad.Trans.Writer
import qualified Control.Monad.Trans.Writer.Strict as Strict
import qualified Control.Monad.Trans.RWS as RWS
import qualified Control.Monad.Trans.RWS.Strict as Strict
class Monad m => MonadSh m where
liftSh :: Sh a -> m a
instance MonadSh Sh where
liftSh = id
instance MonadSh m => MonadSh (IdentityT m) where
liftSh = IdentityT . liftSh
instance MonadSh m => MonadSh (ListT m) where
liftSh m = ListT $ do
a <- liftSh m
return [a]
instance MonadSh m => MonadSh (MaybeT m) where
liftSh = MaybeT . liftM Just . liftSh
instance MonadSh m => MonadSh (ContT r m) where
liftSh m = ContT (liftSh m >>=)
instance (Error e, MonadSh m) => MonadSh (ErrorT e m) where
liftSh m = ErrorT $ do
a <- liftSh m
return (Right a)
instance MonadSh m => MonadSh (ReaderT r m) where
liftSh = ReaderT . const . liftSh
instance MonadSh m => MonadSh (StateT s m) where
liftSh m = StateT $ \s -> do
a <- liftSh m
return (a, s)
instance MonadSh m => MonadSh (Strict.StateT s m) where
liftSh m = Strict.StateT $ \s -> do
a <- liftSh m
return (a, s)
instance (Monoid w, MonadSh m) => MonadSh (WriterT w m) where
liftSh m = WriterT $ do
a <- liftSh m
return (a, mempty :: w)
instance (Monoid w, MonadSh m) => MonadSh (Strict.WriterT w m) where
liftSh m = Strict.WriterT $ do
a <- liftSh m
return (a, mempty :: w)
instance (Monoid w, MonadSh m) => MonadSh (RWS.RWST r w s m) where
liftSh m = RWS.RWST $ \_ s -> do
a <- liftSh m
return (a, s, mempty :: w)
instance (Monoid w, MonadSh m) => MonadSh (Strict.RWST r w s m) where
liftSh m = Strict.RWST $ \_ s -> do
a <- liftSh m
return (a, s, mempty :: w)
instance MonadSh m => S.ShellCmd (m Text) where
cmdAll = (liftSh .) . S.run
instance (MonadSh m, s ~ Text, Show s) => S.ShellCmd (m s) where
cmdAll = (liftSh .) . S.run
instance MonadSh m => S.ShellCmd (m ()) where
cmdAll = (liftSh .) . S.run_
class Monad m => MonadShControl m where
data ShM m a :: *
liftShWith :: ((forall x. m x -> Sh (ShM m x)) -> Sh a) -> m a
restoreSh :: ShM m a -> m a
instance MonadShControl Sh where
newtype ShM Sh a = ShSh a
liftShWith f = f $ liftM ShSh
restoreSh (ShSh x) = return x
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance MonadShControl m => MonadShControl (ListT m) where
newtype ShM (ListT m) a = ListTShM (ShM m [a])
liftShWith f =
ListT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->
liftM ListTShM $ runInSh $ runListT k
restoreSh (ListTShM m) = ListT . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance MonadShControl m => MonadShControl (MaybeT m) where
newtype ShM (MaybeT m) a = MaybeTShM (ShM m (Maybe a))
liftShWith f =
MaybeT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->
liftM MaybeTShM $ runInSh $ runMaybeT k
restoreSh (MaybeTShM m) = MaybeT . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance MonadShControl m
=> MonadShControl (IdentityT m) where
newtype ShM (IdentityT m) a = IdentityTShM (ShM m a)
liftShWith f =
IdentityT $ liftM id $ liftShWith $ \runInSh -> f $ \k ->
liftM IdentityTShM $ runInSh $ runIdentityT k
restoreSh (IdentityTShM m) = IdentityT . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance (MonadShControl m, Monoid w)
=> MonadShControl (WriterT w m) where
newtype ShM (WriterT w m) a = WriterTShM (ShM m (a, w))
liftShWith f =
WriterT $ liftM (\x -> (x, mempty :: w)) $ liftShWith $ \runInSh -> f $ \k ->
liftM WriterTShM $ runInSh $ runWriterT k
restoreSh (WriterTShM m) = WriterT . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance (MonadShControl m, Monoid w)
=> MonadShControl (Strict.WriterT w m) where
newtype ShM (Strict.WriterT w m) a = StWriterTShM (ShM m (a, w))
liftShWith f =
Strict.WriterT $ liftM (\x -> (x, mempty :: w)) $ liftShWith $ \runInSh -> f $ \k ->
liftM StWriterTShM $ runInSh $ Strict.runWriterT k
restoreSh (StWriterTShM m) = Strict.WriterT . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance (MonadShControl m, Error e)
=> MonadShControl (ErrorT e m) where
newtype ShM (ErrorT e m) a = ErrorTShM (ShM m (Either e a))
liftShWith f =
ErrorT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->
liftM ErrorTShM $ runInSh $ runErrorT k
restoreSh (ErrorTShM m) = ErrorT . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance MonadShControl m => MonadShControl (StateT s m) where
newtype ShM (StateT s m) a = StateTShM (ShM m (a, s))
liftShWith f = StateT $ \s ->
liftM (\x -> (x,s)) $ liftShWith $ \runInSh -> f $ \k ->
liftM StateTShM $ runInSh $ runStateT k s
restoreSh (StateTShM m) = StateT . const . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance MonadShControl m => MonadShControl (Strict.StateT s m) where
newtype ShM (Strict.StateT s m) a = StStateTShM (ShM m (a, s))
liftShWith f = Strict.StateT $ \s ->
liftM (\x -> (x,s)) $ liftShWith $ \runInSh -> f $ \k ->
liftM StStateTShM $ runInSh $ Strict.runStateT k s
restoreSh (StStateTShM m) = Strict.StateT . const . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance MonadShControl m => MonadShControl (ReaderT r m) where
newtype ShM (ReaderT r m) a = ReaderTShM (ShM m a)
liftShWith f = ReaderT $ \r ->
liftM id $ liftShWith $ \runInSh -> f $ \k ->
liftM ReaderTShM $ runInSh $ runReaderT k r
restoreSh (ReaderTShM m) = ReaderT . const . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance (MonadShControl m, Monoid w)
=> MonadShControl (RWS.RWST r w s m) where
newtype ShM (RWS.RWST r w s m) a = RWSTShM (ShM m (a, s ,w))
liftShWith f = RWS.RWST $ \r s ->
liftM (\x -> (x,s,mempty :: w)) $ liftShWith $ \runInSh -> f $ \k ->
liftM RWSTShM $ runInSh $ RWS.runRWST k r s
restoreSh (RWSTShM m) = RWS.RWST . const . const . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
instance (MonadShControl m, Monoid w)
=> MonadShControl (Strict.RWST r w s m) where
newtype ShM (Strict.RWST r w s m) a = StRWSTShM (ShM m (a, s, w))
liftShWith f = Strict.RWST $ \r s ->
liftM (\x -> (x,s,mempty :: w)) $ liftShWith $ \runInSh -> f $ \k ->
liftM StRWSTShM $ runInSh $ Strict.runRWST k r s
restoreSh (StRWSTShM m) = Strict.RWST . const . const . restoreSh $ m
{-# INLINE liftShWith #-}
{-# INLINE restoreSh #-}
controlSh :: MonadShControl m => ((forall x. m x -> Sh (ShM m x)) -> Sh (ShM m a)) -> m a
controlSh = liftShWith >=> restoreSh
{-# INLINE controlSh #-}
tag :: (MonadShControl m, MonadSh m) => m a -> Text -> m a
tag action msg = controlSh $ \runInSh -> S.tag (runInSh action) msg
chdir :: MonadShControl m => FilePath -> m a -> m a
chdir dir action = controlSh $ \runInSh -> S.chdir dir (runInSh action)
chdir_p :: MonadShControl m => FilePath -> m a -> m a
chdir_p dir action = controlSh $ \runInSh -> S.chdir_p dir (runInSh action)
silently :: MonadShControl m => m a -> m a
silently a = controlSh $ \runInSh -> S.silently (runInSh a)
verbosely :: MonadShControl m => m a -> m a
verbosely a = controlSh $ \runInSh -> S.verbosely (runInSh a)
log_stdout_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a
log_stdout_with logger a = controlSh $ \runInSh -> S.log_stdout_with logger (runInSh a)
log_stderr_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a
log_stderr_with logger a = controlSh $ \runInSh -> S.log_stderr_with logger (runInSh a)
print_stdout :: MonadShControl m => Bool -> m a -> m a
print_stdout shouldPrint a = controlSh $ \runInSh -> S.print_stdout shouldPrint (runInSh a)
print_stderr :: MonadShControl m => Bool -> m a -> m a
print_stderr shouldPrint a = controlSh $ \runInSh -> S.print_stderr shouldPrint (runInSh a)
print_commands :: MonadShControl m => Bool -> m a -> m a
print_commands shouldPrint a = controlSh $ \runInSh -> S.print_commands shouldPrint (runInSh a)
sub :: MonadShControl m => m a -> m a
sub a = controlSh $ \runInSh -> S.sub (runInSh a)
trace :: MonadSh m => Text -> m ()
trace = liftSh . S.trace
tracing :: MonadShControl m => Bool -> m a -> m a
tracing shouldTrace action = controlSh $ \runInSh -> S.tracing shouldTrace (runInSh action)
escaping :: MonadShControl m => Bool -> m a -> m a
escaping shouldEscape action = controlSh $ \runInSh -> S.escaping shouldEscape (runInSh action)
errExit :: MonadShControl m => Bool -> m a -> m a
errExit shouldExit action = controlSh $ \runInSh -> S.errExit shouldExit (runInSh action)
followSymlink :: MonadShControl m => Bool -> m a -> m a
followSymlink enableFollowSymlink action = controlSh $ \runInSh -> S.followSymlink enableFollowSymlink (runInSh action)
(-|-) :: (MonadShControl m, MonadSh m) => m Text -> m b -> m b
one -|- two = controlSh $ \runInSh -> do
x <- runInSh one
runInSh $ restoreSh x >>= \x' ->
controlSh $ \runInSh' -> return x' S.-|- runInSh' two
withTmpDir :: MonadShControl m => (FilePath -> m a) -> m a
withTmpDir action = controlSh $ \runInSh -> S.withTmpDir (fmap runInSh action)
time :: MonadShControl m => m a -> m (Double, a)
time what = controlSh $ \runInSh -> do
(d, a) <- S.time (runInSh what)
runInSh $ restoreSh a >>= \x -> return (d, x)
toTextWarn :: MonadSh m => FilePath -> m Text
toTextWarn = liftSh . toTextWarn
transferLinesAndCombine :: MonadIO m => Handle -> (Text -> IO ()) -> m Text
transferLinesAndCombine = (liftIO .) . S.transferLinesAndCombine
get :: MonadSh m => m S.State
get = liftSh S.get
put :: MonadSh m => S.State -> m ()
put = liftSh . S.put
catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a
catch_sh = Control.Exception.Lifted.catch
{-# DEPRECATED catch_sh "use Control.Exception.Lifted.catch instead" #-}
handle_sh :: (Exception e) => (e -> Sh a) -> Sh a -> Sh a
handle_sh = handle
{-# DEPRECATED handle_sh "use Control.Exception.Lifted.handle instead" #-}
finally_sh :: Sh a -> Sh b -> Sh a
finally_sh = finally
{-# DEPRECATED finally_sh "use Control.Exception.Lifted.finally instead" #-}
bracket_sh :: Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c
bracket_sh = bracket
{-# DEPRECATED bracket_sh "use Control.Exception.Lifted.bracket instead" #-}
catches_sh :: Sh a -> [Handler Sh a] -> Sh a
catches_sh = catches
{-# DEPRECATED catches_sh "use Control.Exception.Lifted.catches instead" #-}
catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a
catchany_sh = catchAny
{-# DEPRECATED catchany_sh "use Control.Exception.Enclosed.catchAny instead" #-}
handleany_sh :: (SomeException -> Sh a) -> Sh a -> Sh a
handleany_sh = handleAny
{-# DEPRECATED handleany_sh "use Control.Exception.Enclosed.handleAny instead" #-}
cd :: MonadSh m => FilePath -> m ()
cd = liftSh . S.cd
mv :: MonadSh m => FilePath -> FilePath -> m ()
mv = (liftSh .) . S.mv
lsT :: MonadSh m => FilePath -> m [Text]
lsT = liftSh . S.lsT
pwd :: MonadSh m => m FilePath
pwd = liftSh S.pwd
exit :: MonadSh m => Int -> m a
exit = liftSh . S.exit
errorExit :: MonadSh m => Text -> m a
errorExit = liftSh . S.errorExit
quietExit :: MonadSh m => Int -> m a
quietExit = liftSh . S.quietExit
terror :: MonadSh m => Text -> m a
terror = liftSh . S.terror
mkdir :: MonadSh m => FilePath -> m ()
mkdir = liftSh . S.mkdir
mkdir_p :: MonadSh m => FilePath -> m ()
mkdir_p = liftSh . S.mkdir_p
mkdirTree :: MonadSh m => Tree FilePath -> m ()
mkdirTree = liftSh . S.mkdirTree
which :: MonadSh m => FilePath -> m (Maybe FilePath)
which = liftSh . S.which
test_e :: MonadSh m => FilePath -> m Bool
test_e = liftSh . S.test_e
test_f :: MonadSh m => FilePath -> m Bool
test_f = liftSh . S.test_f
test_px :: MonadSh m => FilePath -> m Bool
test_px = liftSh . S.test_px
rm_rf :: MonadSh m => FilePath -> m ()
rm_rf = liftSh . S.rm_rf
rm_f :: MonadSh m => FilePath -> m ()
rm_f = liftSh . S.rm_f
rm :: MonadSh m => FilePath -> m ()
rm = liftSh . S.rm
setenv :: MonadSh m => Text -> Text -> m ()
setenv = (liftSh .) . S.setenv
appendToPath :: MonadSh m => FilePath -> m ()
appendToPath = liftSh . S.appendToPath
prependToPath :: MonadSh m => FilePath -> m ()
prependToPath = liftSh . S.prependToPath
get_env_all :: MonadSh m => m [(String, String)]
get_env_all = liftSh S.get_env_all
get_env :: MonadSh m => Text -> m (Maybe Text)
get_env = liftSh . S.get_env
get_env_text :: MonadSh m => Text -> m Text
get_env_text = liftSh . S.get_env_text
sshPairs_ :: MonadSh m => Text -> [(FilePath, [Text])] -> m ()
sshPairs_ = (liftSh .) . S.sshPairs_
sshPairs :: MonadSh m => Text -> [(FilePath, [Text])] -> m Text
sshPairs = (liftSh .) . S.sshPairs
run :: MonadSh m => FilePath -> [Text] -> m Text
run = (liftSh .) . S.run
command :: MonadSh m => FilePath -> [Text] -> [Text] -> m Text
command com args more_args =
liftSh $ S.command com args more_args
command_ :: MonadSh m => FilePath -> [Text] -> [Text] -> m ()
command_ com args more_args =
liftSh $ S.command_ com args more_args
command1 :: MonadSh m => FilePath -> [Text] -> Text -> [Text] -> m Text
command1 com args one_arg more_args =
liftSh $ S.command1 com args one_arg more_args
command1_ :: MonadSh m => FilePath -> [Text] -> Text -> [Text] -> m ()
command1_ com args one_arg more_args =
liftSh $ S.command1_ com args one_arg more_args
run_ :: MonadSh m => FilePath -> [Text] -> m ()
run_ = (liftSh .) . S.run_
runHandle :: MonadShControl m => FilePath
-> [Text]
-> (Handle -> m a)
-> m a
runHandle exe args withHandle =
controlSh $ \runInSh -> S.runHandle exe args (fmap runInSh withHandle)
runHandles :: MonadShControl m => FilePath
-> [Text]
-> [S.StdHandle]
-> (Handle -> Handle -> Handle -> m a)
-> m a
runHandles exe args reusedHandles withHandles =
controlSh $ \runInSh ->
S.runHandles exe args reusedHandles (fmap (fmap (fmap runInSh)) withHandles)
runFoldLines :: MonadSh m => a -> S.FoldCallback a -> FilePath -> [Text] -> m a
runFoldLines start cb exe args = liftSh $ S.runFoldLines start cb exe args
lastStderr :: MonadSh m => m Text
lastStderr = liftSh S.lastStderr
lastExitCode :: MonadSh m => m Int
lastExitCode = liftSh S.lastExitCode
setStdin :: MonadSh m => Text -> m ()
setStdin = liftSh . S.setStdin
cp_r :: MonadSh m => FilePath -> FilePath -> m ()
cp_r = (liftSh .) . S.cp_r
cp :: MonadSh m => FilePath -> FilePath -> m ()
cp = (liftSh .) . S.cp
writefile :: MonadSh m => FilePath -> Text -> m ()
writefile = (liftSh .) . S.writefile
touchfile :: MonadSh m => FilePath -> m ()
touchfile = liftSh . S.touchfile
appendfile :: MonadSh m => FilePath -> Text -> m ()
appendfile = (liftSh .) . S.appendfile
readfile :: MonadSh m => FilePath -> m Text
readfile = liftSh . S.readfile
readBinary :: MonadSh m => FilePath -> m ByteString
readBinary = liftSh . S.readBinary
sleep :: MonadSh m => Int -> m ()
sleep = liftSh . S.sleep
echo, echo_n, echo_err, echo_n_err :: MonadSh m => Text -> m ()
echo = liftSh . S.echo
echo_n = liftSh . S.echo_n
echo_err = liftSh . S.echo_err
echo_n_err = liftSh . S.echo_n_err
relPath :: MonadSh m => FilePath -> m FilePath
relPath = liftSh . S.relPath
relativeTo :: MonadSh m => FilePath
-> FilePath
-> m FilePath
relativeTo = (liftSh .) . S.relativeTo
canonic :: MonadSh m => FilePath -> m FilePath
canonic = liftSh . canonic
canonicalize :: MonadSh m => FilePath -> m FilePath
canonicalize = liftSh . S.canonicalize
absPath :: MonadSh m => FilePath -> m FilePath
absPath = liftSh . S.absPath
test_d :: MonadSh m => FilePath -> m Bool
test_d = liftSh . S.test_d
test_s :: MonadSh m => FilePath -> m Bool
test_s = liftSh . S.test_s
ls :: MonadSh m => FilePath -> m [FilePath]
ls = liftSh . S.ls
inspect :: (Show s, MonadSh m) => s -> m ()
inspect = liftSh . S.inspect
inspect_err :: (Show s, MonadSh m) => s -> m ()
inspect_err = liftSh . S.inspect_err
catchany :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a
catchany = Control.Exception.Lifted.catch