{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE InstanceSigs#-}
module Shelly.Base
(
Sh(..), ShIO, runSh, State(..), ReadOnlyState(..), StdHandle(..),
HandleInitializer, StdInit(..),
FilePath, Text,
relPath, path, absPath, canonic, canonicalize,
test_d, test_s,
unpack, gets, get, modify, trace,
ls, lsRelAbs,
toTextIgnore,
echo, echo_n, echo_err, echo_n_err, inspect, inspect_err,
catchany,
liftIO, (>=>),
eitherRelativeTo, relativeTo, maybeRelativeTo,
whenM
, addTrailingSlash
) where
import Data.Text (Text)
import System.Process( StdStream(..) )
import System.IO ( Handle, hFlush, stderr, stdout )
import Control.Monad ( when, (>=>) )
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
import Control.Applicative (Applicative, (<$>))
import Data.Monoid (mappend)
#endif
import Control.Monad.Base
import Control.Monad.Trans.Control
import System.Directory( doesDirectoryExist, listDirectory)
import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink )
import System.FilePath ( isRelative)
import qualified System.FilePath as FP
import qualified System.Directory as FS
import Data.IORef (readIORef, modifyIORef, IORef)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Control.Exception (SomeException, catch, throwIO, Exception)
import Data.Maybe (fromMaybe)
import qualified Control.Monad.Catch as Catch
import Control.Monad.Trans ( MonadIO, liftIO )
import Control.Monad.Reader.Class (MonadReader, ask)
import Control.Monad.Trans.Reader (runReaderT, ReaderT(..))
import qualified Data.Set as S
import Data.Typeable (Typeable)
type ShIO a = Sh a
{-# DEPRECATED ShIO "Use Sh instead of ShIO" #-}
newtype Sh a = Sh {
Sh a -> ReaderT (IORef State) IO a
unSh :: ReaderT (IORef State) IO a
} deriving (Functor Sh
a -> Sh a
Functor Sh
-> (forall a. a -> Sh a)
-> (forall a b. Sh (a -> b) -> Sh a -> Sh b)
-> (forall a b c. (a -> b -> c) -> Sh a -> Sh b -> Sh c)
-> (forall a b. Sh a -> Sh b -> Sh b)
-> (forall a b. Sh a -> Sh b -> Sh a)
-> Applicative Sh
Sh a -> Sh b -> Sh b
Sh a -> Sh b -> Sh a
Sh (a -> b) -> Sh a -> Sh b
(a -> b -> c) -> Sh a -> Sh b -> Sh c
forall a. a -> Sh a
forall a b. Sh a -> Sh b -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall a b. Sh (a -> b) -> Sh a -> Sh b
forall a b c. (a -> b -> c) -> Sh a -> Sh b -> Sh c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Sh a -> Sh b -> Sh a
$c<* :: forall a b. Sh a -> Sh b -> Sh a
*> :: Sh a -> Sh b -> Sh b
$c*> :: forall a b. Sh a -> Sh b -> Sh b
liftA2 :: (a -> b -> c) -> Sh a -> Sh b -> Sh c
$cliftA2 :: forall a b c. (a -> b -> c) -> Sh a -> Sh b -> Sh c
<*> :: Sh (a -> b) -> Sh a -> Sh b
$c<*> :: forall a b. Sh (a -> b) -> Sh a -> Sh b
pure :: a -> Sh a
$cpure :: forall a. a -> Sh a
$cp1Applicative :: Functor Sh
Applicative, Applicative Sh
a -> Sh a
Applicative Sh
-> (forall a b. Sh a -> (a -> Sh b) -> Sh b)
-> (forall a b. Sh a -> Sh b -> Sh b)
-> (forall a. a -> Sh a)
-> Monad Sh
Sh a -> (a -> Sh b) -> Sh b
Sh a -> Sh b -> Sh b
forall a. a -> Sh a
forall a b. Sh a -> Sh b -> Sh b
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Sh a
$creturn :: forall a. a -> Sh a
>> :: Sh a -> Sh b -> Sh b
$c>> :: forall a b. Sh a -> Sh b -> Sh b
>>= :: Sh a -> (a -> Sh b) -> Sh b
$c>>= :: forall a b. Sh a -> (a -> Sh b) -> Sh b
$cp1Monad :: Applicative Sh
Monad, Monad Sh
Monad Sh -> (forall a. String -> Sh a) -> MonadFail Sh
String -> Sh a
forall a. String -> Sh a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Sh a
$cfail :: forall a. String -> Sh a
$cp1MonadFail :: Monad Sh
MonadFail, Monad Sh
Monad Sh -> (forall a. IO a -> Sh a) -> MonadIO Sh
IO a -> Sh a
forall a. IO a -> Sh a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Sh a
$cliftIO :: forall a. IO a -> Sh a
$cp1MonadIO :: Monad Sh
MonadIO, MonadReader (IORef State), a -> Sh b -> Sh a
(a -> b) -> Sh a -> Sh b
(forall a b. (a -> b) -> Sh a -> Sh b)
-> (forall a b. a -> Sh b -> Sh a) -> Functor Sh
forall a b. a -> Sh b -> Sh a
forall a b. (a -> b) -> Sh a -> Sh b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Sh b -> Sh a
$c<$ :: forall a b. a -> Sh b -> Sh a
fmap :: (a -> b) -> Sh a -> Sh b
$cfmap :: forall a b. (a -> b) -> Sh a -> Sh b
Functor, MonadCatch Sh
MonadCatch Sh
-> (forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b)
-> (forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b)
-> (forall a b c.
Sh a -> (a -> ExitCase b -> Sh c) -> (a -> Sh b) -> Sh (b, c))
-> MonadMask Sh
Sh a -> (a -> ExitCase b -> Sh c) -> (a -> Sh b) -> Sh (b, c)
((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
forall a b c.
Sh a -> (a -> ExitCase b -> Sh c) -> (a -> Sh b) -> Sh (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: Sh a -> (a -> ExitCase b -> Sh c) -> (a -> Sh b) -> Sh (b, c)
$cgeneralBracket :: forall a b c.
Sh a -> (a -> ExitCase b -> Sh c) -> (a -> Sh b) -> Sh (b, c)
uninterruptibleMask :: ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
$cuninterruptibleMask :: forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
mask :: ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
$cmask :: forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
$cp1MonadMask :: MonadCatch Sh
Catch.MonadMask)
instance MonadBase IO Sh where
liftBase :: IO α -> Sh α
liftBase = ReaderT (IORef State) IO α -> Sh α
forall a. ReaderT (IORef State) IO a -> Sh a
Sh (ReaderT (IORef State) IO α -> Sh α)
-> (IO α -> ReaderT (IORef State) IO α) -> IO α -> Sh α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef State -> IO α) -> ReaderT (IORef State) IO α
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((IORef State -> IO α) -> ReaderT (IORef State) IO α)
-> (IO α -> IORef State -> IO α)
-> IO α
-> ReaderT (IORef State) IO α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO α -> IORef State -> IO α
forall a b. a -> b -> a
const
instance MonadBaseControl IO Sh where
#if MIN_VERSION_monad_control(1,0,0)
type StM Sh a = StM (ReaderT (IORef State) IO) a
liftBaseWith :: (RunInBase Sh IO -> IO a) -> Sh a
liftBaseWith RunInBase Sh IO -> IO a
f =
ReaderT (IORef State) IO a -> Sh a
forall a. ReaderT (IORef State) IO a -> Sh a
Sh (ReaderT (IORef State) IO a -> Sh a)
-> ReaderT (IORef State) IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ (RunInBase (ReaderT (IORef State) IO) IO -> IO a)
-> ReaderT (IORef State) IO a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase (ReaderT (IORef State) IO) IO -> IO a)
-> ReaderT (IORef State) IO a)
-> (RunInBase (ReaderT (IORef State) IO) IO -> IO a)
-> ReaderT (IORef State) IO a
forall a b. (a -> b) -> a -> b
$ \RunInBase (ReaderT (IORef State) IO) IO
runInBase -> RunInBase Sh IO -> IO a
f (RunInBase Sh IO -> IO a) -> RunInBase Sh IO -> IO a
forall a b. (a -> b) -> a -> b
$ \Sh a
k ->
ReaderT (IORef State) IO a -> IO (StM (ReaderT (IORef State) IO) a)
RunInBase (ReaderT (IORef State) IO) IO
runInBase (ReaderT (IORef State) IO a
-> IO (StM (ReaderT (IORef State) IO) a))
-> ReaderT (IORef State) IO a
-> IO (StM (ReaderT (IORef State) IO) a)
forall a b. (a -> b) -> a -> b
$ Sh a -> ReaderT (IORef State) IO a
forall a. Sh a -> ReaderT (IORef State) IO a
unSh Sh a
k
restoreM :: StM Sh a -> Sh a
restoreM = ReaderT (IORef State) IO a -> Sh a
forall a. ReaderT (IORef State) IO a -> Sh a
Sh (ReaderT (IORef State) IO a -> Sh a)
-> (a -> ReaderT (IORef State) IO a) -> a -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT (IORef State) IO a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
#else
newtype StM Sh a = StMSh (StM (ReaderT (IORef State) IO) a)
liftBaseWith f =
Sh $ liftBaseWith $ \runInBase -> f $ \k ->
liftM StMSh $ runInBase $ unSh k
restoreM (StMSh m) = Sh . restoreM $ m
#endif
instance Catch.MonadThrow Sh where
throwM :: e -> Sh a
throwM = IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Sh a) -> (e -> IO a) -> e -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM
instance Catch.MonadCatch Sh where
catch :: Sh a -> (e -> Sh a) -> Sh a
catch (Sh (ReaderT IORef State -> IO a
m)) e -> Sh a
c =
ReaderT (IORef State) IO a -> Sh a
forall a. ReaderT (IORef State) IO a -> Sh a
Sh (ReaderT (IORef State) IO a -> Sh a)
-> ReaderT (IORef State) IO a -> Sh a
forall a b. (a -> b) -> a -> b
$ (IORef State -> IO a) -> ReaderT (IORef State) IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((IORef State -> IO a) -> ReaderT (IORef State) IO a)
-> (IORef State -> IO a) -> ReaderT (IORef State) IO a
forall a b. (a -> b) -> a -> b
$ \IORef State
r -> IORef State -> IO a
m IORef State
r IO a -> (e -> IO a) -> IO a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Catch.catch` \e
e -> Sh a -> IORef State -> IO a
forall a. Sh a -> IORef State -> IO a
runSh (e -> Sh a
c e
e) IORef State
r
runSh :: Sh a -> IORef State -> IO a
runSh :: Sh a -> IORef State -> IO a
runSh = ReaderT (IORef State) IO a -> IORef State -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT (IORef State) IO a -> IORef State -> IO a)
-> (Sh a -> ReaderT (IORef State) IO a)
-> Sh a
-> IORef State
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sh a -> ReaderT (IORef State) IO a
forall a. Sh a -> ReaderT (IORef State) IO a
unSh
data ReadOnlyState = ReadOnlyState { ReadOnlyState -> Bool
rosFailToDir :: Bool }
data State = State
{ State -> Int
sCode :: Int
, State -> Maybe Text
sStdin :: Maybe Text
, State -> Text
sStderr :: Text
, State -> String
sDirectory :: FilePath
, State -> Text -> IO ()
sPutStdout :: Text -> IO ()
, State -> Bool
sPrintStdout :: Bool
, State -> Text -> IO ()
sPutStderr :: Text -> IO ()
, State -> Bool
sPrintStderr :: Bool
, State -> Bool
sPrintCommands :: Bool
, State -> StdInit
sInitCommandHandles :: StdInit
, State -> Bool
sCommandEscaping :: Bool
, State -> [(String, String)]
sEnvironment :: [(String, String)]
, State -> Maybe [(String, Set String)]
sPathExecutables :: Maybe [(FilePath, S.Set FilePath)]
, State -> Bool
sTracing :: Bool
, State -> Text
sTrace :: Text
, State -> Bool
sErrExit :: Bool
, State -> ReadOnlyState
sReadOnly :: ReadOnlyState
, State -> Bool
sFollowSymlink :: Bool
}
data StdHandle = InHandle StdStream
| OutHandle StdStream
| ErrorHandle StdStream
type HandleInitializer = Handle -> IO ()
data StdInit =
StdInit {
StdInit -> HandleInitializer
inInit :: HandleInitializer,
StdInit -> HandleInitializer
outInit :: HandleInitializer,
StdInit -> HandleInitializer
errInit :: HandleInitializer
}
whenM :: Monad m => m Bool -> m () -> m ()
whenM :: m Bool -> m () -> m ()
whenM m Bool
c m ()
a = m Bool
c m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
res -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
res m ()
a
relPath :: FilePath -> Sh FilePath
relPath :: String -> Sh String
relPath String
fp = do
String
wd <- (State -> String) -> Sh String
forall a. (State -> a) -> Sh a
gets State -> String
sDirectory
Either String String
rel <- String -> String -> Sh (Either String String)
eitherRelativeTo String
wd String
fp
String -> Sh String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Sh String) -> String -> Sh String
forall a b. (a -> b) -> a -> b
$ case Either String String
rel of
Right String
p -> String
p
Left String
p -> String
p
eitherRelativeTo
:: FilePath
-> FilePath
-> Sh (Either FilePath FilePath)
eitherRelativeTo :: String -> String -> Sh (Either String String)
eitherRelativeTo String
relativeFP String
fp = do
let fullFp :: String
fullFp = String
relativeFP String -> String -> String
FP.</> String
fp
let relDir :: String
relDir = String -> String
addTrailingSlash String
relativeFP
String
-> String -> Sh (Either String String) -> Sh (Either String String)
stripIt String
relativeFP String
fp (Sh (Either String String) -> Sh (Either String String))
-> Sh (Either String String) -> Sh (Either String String)
forall a b. (a -> b) -> a -> b
$
String
-> String -> Sh (Either String String) -> Sh (Either String String)
stripIt String
relativeFP String
fullFp (Sh (Either String String) -> Sh (Either String String))
-> Sh (Either String String) -> Sh (Either String String)
forall a b. (a -> b) -> a -> b
$
String
-> String -> Sh (Either String String) -> Sh (Either String String)
stripIt String
relDir String
fp (Sh (Either String String) -> Sh (Either String String))
-> Sh (Either String String) -> Sh (Either String String)
forall a b. (a -> b) -> a -> b
$
String
-> String -> Sh (Either String String) -> Sh (Either String String)
stripIt String
relDir String
fullFp (Sh (Either String String) -> Sh (Either String String))
-> Sh (Either String String) -> Sh (Either String String)
forall a b. (a -> b) -> a -> b
$ do
String
relCan <- String -> Sh String
canonic String
relDir
String
fpCan <- String -> Sh String
canonic String
fullFp
String
-> String -> Sh (Either String String) -> Sh (Either String String)
stripIt String
relCan String
fpCan (Sh (Either String String) -> Sh (Either String String))
-> Sh (Either String String) -> Sh (Either String String)
forall a b. (a -> b) -> a -> b
$ Either String String -> Sh (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> Sh (Either String String))
-> Either String String -> Sh (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
fpCan
where
stripIt
:: FilePath
-> FilePath
-> Sh (Either FilePath FilePath)
-> Sh (Either FilePath FilePath)
stripIt :: String
-> String -> Sh (Either String String) -> Sh (Either String String)
stripIt String
rel String
toStrip Sh (Either String String)
nada =
let stripped :: String
stripped = String -> String -> String
FP.makeRelative String
rel String
toStrip
in if String
stripped String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
toStrip
then Sh (Either String String)
nada
else Either String String -> Sh (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> Sh (Either String String))
-> Either String String -> Sh (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right String
stripped
relativeTo :: FilePath
-> FilePath
-> Sh FilePath
relativeTo :: String -> String -> Sh String
relativeTo String
relativeFP String
fp =
(Maybe String -> String) -> Sh (Maybe String) -> Sh String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
fp) (Sh (Maybe String) -> Sh String) -> Sh (Maybe String) -> Sh String
forall a b. (a -> b) -> a -> b
$ String -> String -> Sh (Maybe String)
maybeRelativeTo String
relativeFP String
fp
maybeRelativeTo :: FilePath
-> FilePath
-> Sh (Maybe FilePath)
maybeRelativeTo :: String -> String -> Sh (Maybe String)
maybeRelativeTo String
relativeFP String
fp = do
Either String String
epath <- String -> String -> Sh (Either String String)
eitherRelativeTo String
relativeFP String
fp
Maybe String -> Sh (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Sh (Maybe String))
-> Maybe String -> Sh (Maybe String)
forall a b. (a -> b) -> a -> b
$ case Either String String
epath of
Right String
p -> String -> Maybe String
forall a. a -> Maybe a
Just String
p
Left String
_ -> Maybe String
forall a. Maybe a
Nothing
addTrailingSlash :: FilePath -> FilePath
addTrailingSlash :: String -> String
addTrailingSlash = String -> String
FP.addTrailingPathSeparator
canonic :: FilePath -> Sh FilePath
canonic :: String -> Sh String
canonic String
fp = do
String
p <- String -> Sh String
absPath String
fp
IO String -> Sh String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Sh String) -> IO String -> Sh String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
p IO String -> (SomeException -> IO String) -> IO String
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` \SomeException
_ -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
canonicalize :: FilePath -> Sh FilePath
canonicalize :: String -> Sh String
canonicalize = String -> Sh String
absPath (String -> Sh String)
-> (String -> Sh String) -> String -> Sh String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO String -> Sh String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Sh String)
-> (String -> IO String) -> String -> Sh String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
canonicalizePath
canonicalizePath :: FilePath -> IO FilePath
canonicalizePath :: String -> IO String
canonicalizePath String
p = let was_dir :: Bool
was_dir = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> String
FP.takeFileName String
p) in
if Bool -> Bool
not Bool
was_dir then String -> IO String
FS.canonicalizePath String
p
else String -> String
addTrailingSlash (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO String
FS.canonicalizePath String
p
data EmptyFilePathError = EmptyFilePathError deriving Typeable
instance Show EmptyFilePathError where
show :: EmptyFilePathError -> String
show EmptyFilePathError
_ = String
"Empty filepath"
instance Exception EmptyFilePathError
absPath :: FilePath -> Sh FilePath
absPath :: String -> Sh String
absPath String
p | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p = IO String -> Sh String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Sh String) -> IO String -> Sh String
forall a b. (a -> b) -> a -> b
$ EmptyFilePathError -> IO String
forall e a. Exception e => e -> IO a
throwIO EmptyFilePathError
EmptyFilePathError
| String -> Bool
isRelative String
p = do
String
cwd <- (State -> String) -> Sh String
forall a. (State -> a) -> Sh a
gets State -> String
sDirectory
String -> Sh String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
cwd String -> String -> String
FP.</> String
p)
| Bool
otherwise = String -> Sh String
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
path :: FilePath -> Sh FilePath
path :: String -> Sh String
path = String -> Sh String
absPath
{-# DEPRECATED path "use absPath, canonic, or relPath instead" #-}
test_d :: FilePath -> Sh Bool
test_d :: String -> Sh Bool
test_d = String -> Sh String
absPath (String -> Sh String) -> (String -> Sh Bool) -> String -> Sh Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO Bool -> Sh Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Sh Bool) -> (String -> IO Bool) -> String -> Sh Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesDirectoryExist
test_s :: FilePath -> Sh Bool
test_s :: String -> Sh Bool
test_s = String -> Sh String
absPath (String -> Sh String) -> (String -> Sh Bool) -> String -> Sh Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO Bool -> Sh Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Sh Bool) -> (String -> IO Bool) -> String -> Sh Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \String
f -> do
FileStatus
stat <- String -> IO FileStatus
getSymbolicLinkStatus String
f
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FileStatus -> Bool
isSymbolicLink FileStatus
stat
unpack :: FilePath -> String
unpack :: String -> String
unpack = String -> String
forall a. a -> a
id
gets :: (State -> a) -> Sh a
gets :: (State -> a) -> Sh a
gets State -> a
f = State -> a
f (State -> a) -> Sh State -> Sh a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh State
get
get :: Sh State
get :: Sh State
get = do
IORef State
stateVar <- Sh (IORef State)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO State -> Sh State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef State -> IO State
forall a. IORef a -> IO a
readIORef IORef State
stateVar)
modify :: (State -> State) -> Sh ()
modify :: (State -> State) -> Sh ()
modify State -> State
f = do
IORef State
state <- Sh (IORef State)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef State -> (State -> State) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef State
state State -> State
f)
trace :: Text -> Sh ()
trace :: Text -> Sh ()
trace Text
msg =
Sh Bool -> Sh () -> Sh ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((State -> Bool) -> Sh Bool
forall a. (State -> a) -> Sh a
gets State -> Bool
sTracing) (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ (State -> State) -> Sh ()
modify ((State -> State) -> Sh ()) -> (State -> State) -> Sh ()
forall a b. (a -> b) -> a -> b
$
\State
st -> State
st { sTrace :: Text
sTrace = State -> Text
sTrace State
st Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
msg Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"\n" }
ls :: FilePath -> Sh [FilePath]
ls :: String -> Sh [String]
ls String
fp = do
Text -> Sh ()
trace (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text
"ls " Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` String -> Text
toTextIgnore String
fp
(([String], [String]) -> [String])
-> Sh ([String], [String]) -> Sh [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String], [String]) -> [String]
forall a b. (a, b) -> a
fst (Sh ([String], [String]) -> Sh [String])
-> Sh ([String], [String]) -> Sh [String]
forall a b. (a -> b) -> a -> b
$ String -> Sh ([String], [String])
lsRelAbs String
fp
lsRelAbs :: FilePath -> Sh ([FilePath], [FilePath])
lsRelAbs :: String -> Sh ([String], [String])
lsRelAbs String
f = String -> Sh String
absPath String
f Sh String
-> (String -> Sh ([String], [String])) -> Sh ([String], [String])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
fp -> do
[String]
files <- IO [String] -> Sh [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Sh [String]) -> IO [String] -> Sh [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
listDirectory String
fp
let absolute :: [String]
absolute = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
fp String -> String -> String
FP.</>) [String]
files
let relativized :: [String]
relativized = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
p -> [String] -> String
FP.joinPath [String
f, String
p]) [String]
files
([String], [String]) -> Sh ([String], [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
relativized, [String]
absolute)
toTextIgnore :: FilePath -> Text
toTextIgnore :: String -> Text
toTextIgnore = String -> Text
T.pack
inspect :: Show s => s -> Sh ()
inspect :: s -> Sh ()
inspect s
x = do
Text -> Sh ()
trace (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
s
where s :: String
s = s -> String
forall a. Show a => a -> String
show s
x
inspect_err :: Show s => s -> Sh ()
inspect_err :: s -> Sh ()
inspect_err s
x = do
let shown :: Text
shown = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. Show a => a -> String
show s
x
Text -> Sh ()
trace Text
shown
Text -> Sh ()
echo_err Text
shown
echo, echo_n, echo_err, echo_n_err :: Text -> Sh ()
echo :: Text -> Sh ()
echo Text
msg = Text -> Sh ()
traceEcho Text
msg Sh () -> Sh () -> Sh ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO ()
TIO.putStrLn Text
msg IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HandleInitializer
hFlush Handle
stdout)
echo_n :: Text -> Sh ()
echo_n Text
msg = Text -> Sh ()
traceEcho Text
msg Sh () -> Sh () -> Sh ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO ()
TIO.putStr Text
msg IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HandleInitializer
hFlush Handle
stdout)
echo_err :: Text -> Sh ()
echo_err Text
msg = Text -> Sh ()
traceEcho Text
msg Sh () -> Sh () -> Sh ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr Text
msg IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HandleInitializer
hFlush Handle
stdout)
echo_n_err :: Text -> Sh ()
echo_n_err Text
msg = Text -> Sh ()
traceEcho Text
msg Sh () -> Sh () -> Sh ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
TIO.hPutStr Handle
stderr Text
msg IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HandleInitializer
hFlush Handle
stderr)
traceEcho :: Text -> Sh ()
traceEcho :: Text -> Sh ()
traceEcho Text
msg = Text -> Sh ()
trace (Text
"echo " Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"'" Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
msg Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"'")
catchany :: IO a -> (SomeException -> IO a) -> IO a
catchany :: IO a -> (SomeException -> IO a) -> IO a
catchany = IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch