{-# 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
    -- * utilities not yet exported
    , 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)

-- | ShIO is Deprecated in favor of 'Sh', which is easier to type.
type ShIO a = Sh a
{-# DEPRECATED ShIO "Use Sh instead of ShIO" #-}

newtype Sh a = Sh {
      forall a. Sh a -> ReaderT (IORef State) IO a
unSh :: ReaderT (IORef State) IO a
  } deriving (Functor Sh
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
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
$cpure :: forall a. a -> Sh a
pure :: forall a. a -> Sh a
$c<*> :: forall a b. Sh (a -> b) -> Sh a -> Sh b
<*> :: forall a b. Sh (a -> b) -> Sh a -> Sh b
$cliftA2 :: forall a b c. (a -> b -> c) -> Sh a -> Sh b -> Sh c
liftA2 :: forall a b c. (a -> b -> c) -> Sh a -> Sh b -> Sh c
$c*> :: forall a b. Sh a -> Sh b -> Sh b
*> :: forall a b. Sh a -> Sh b -> Sh b
$c<* :: forall a b. Sh a -> Sh b -> Sh a
<* :: forall a b. Sh a -> Sh b -> Sh a
Applicative, Applicative Sh
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
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
$c>>= :: forall a b. Sh a -> (a -> Sh b) -> Sh b
>>= :: forall a b. Sh a -> (a -> Sh b) -> Sh b
$c>> :: forall a b. Sh a -> Sh b -> Sh b
>> :: forall a b. Sh a -> Sh b -> Sh b
$creturn :: forall a. a -> Sh a
return :: forall a. a -> Sh a
Monad, Monad Sh
Monad Sh -> (forall a. FilePath -> Sh a) -> MonadFail Sh
forall a. FilePath -> Sh a
forall (m :: * -> *).
Monad m -> (forall a. FilePath -> m a) -> MonadFail m
$cfail :: forall a. FilePath -> Sh a
fail :: forall a. FilePath -> Sh a
MonadFail, Monad Sh
Monad Sh -> (forall a. IO a -> Sh a) -> MonadIO Sh
forall a. IO a -> Sh a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Sh a
liftIO :: forall a. IO a -> Sh a
MonadIO, MonadReader (IORef State), (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
$cfmap :: forall a b. (a -> b) -> Sh a -> Sh b
fmap :: forall a b. (a -> b) -> Sh a -> Sh b
$c<$ :: forall a b. a -> Sh b -> Sh a
<$ :: forall a b. a -> Sh b -> Sh a
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
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
$cmask :: forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
mask :: forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
$cuninterruptibleMask :: forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
uninterruptibleMask :: forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
$cgeneralBracket :: forall a b c.
Sh a -> (a -> ExitCase b -> Sh c) -> (a -> Sh b) -> Sh (b, c)
generalBracket :: forall a b c.
Sh a -> (a -> ExitCase b -> Sh c) -> (a -> Sh b) -> Sh (b, c)
Catch.MonadMask)

instance MonadBase IO Sh where
    liftBase :: forall a. IO a -> Sh a
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 :: forall a. (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 a.
(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 :: forall a. 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
StM (ReaderT (IORef State) IO) a -> ReaderT (IORef State) IO a
forall a.
StM (ReaderT (IORef State) IO) 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 :: forall e a. Exception e => e -> Sh a
throwM = IO a -> Sh a
forall a. 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 e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM

instance Catch.MonadCatch Sh where
  catch :: forall e a. Exception e => 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 e a. Exception e => 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 :: forall a. 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 -- ^ exit code for command that ran
   , State -> Maybe Text
sStdin :: Maybe Text -- ^ stdin for the command to be run
   , State -> Text
sStderr :: Text -- ^ stderr for command that ran
   , State -> FilePath
sDirectory :: FilePath -- ^ working directory
   , State -> Text -> IO ()
sPutStdout :: Text -> IO ()   -- ^ by default, hPutStrLn stdout
   , State -> Bool
sPrintStdout :: Bool   -- ^ print stdout of command that is executed
   , State -> Text -> IO ()
sPutStderr :: Text -> IO ()   -- ^ by default, hPutStrLn stderr
   , State -> Bool
sPrintStderr :: Bool   -- ^ print stderr of command that is executed
   , State -> Bool
sPrintCommands :: Bool -- ^ print command that is executed
   , State -> StdInit
sInitCommandHandles :: StdInit -- ^ initializers for the standard process handles
                                    -- when running a command
   , State -> Bool
sCommandEscaping :: Bool -- ^ when running a command, escape shell characters such as '*' rather
                              -- than passing to the shell for expansion
   , State -> [(FilePath, FilePath)]
sEnvironment :: [(String, String)]
   , State -> Maybe [(FilePath, Set FilePath)]
sPathExecutables :: Maybe [(FilePath, S.Set FilePath)] -- ^ cache of executables in the PATH
   , State -> Bool
sTracing :: Bool -- ^ should we trace command execution
   , State -> Text
sTrace :: Text -- ^ the trace of command execution
   , State -> Bool
sErrExit :: Bool -- ^ should we exit immediately on any error
   , State -> ReadOnlyState
sReadOnly :: ReadOnlyState
   , State -> Bool
sFollowSymlink :: Bool -- ^ 'find'-command follows symlinks.
   }

data StdHandle = InHandle StdStream
               | OutHandle StdStream
               | ErrorHandle StdStream

-- | Initialize a handle before using it.
type HandleInitializer = Handle -> IO ()

-- | A collection of initializers for the three standard process handles.
data StdInit =
    StdInit {
      StdInit -> HandleInitializer
inInit :: HandleInitializer,
      StdInit -> HandleInitializer
outInit :: HandleInitializer,
      StdInit -> HandleInitializer
errInit :: HandleInitializer
    }

-- | A monadic-conditional version of the 'when' guard.
whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
c m ()
a = m Bool
c m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
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

-- | Makes a relative path relative to the current 'Sh' working directory.
-- An absolute path is returned as is.
-- To create an absolute path, use 'absPath'.
relPath :: FilePath -> Sh FilePath
relPath :: FilePath -> Sh FilePath
relPath FilePath
fp = do
  FilePath
wd  <- (State -> FilePath) -> Sh FilePath
forall a. (State -> a) -> Sh a
gets State -> FilePath
sDirectory
  Either FilePath FilePath
rel <- FilePath -> FilePath -> Sh (Either FilePath FilePath)
eitherRelativeTo FilePath
wd FilePath
fp
  FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Sh FilePath) -> FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ case Either FilePath FilePath
rel of
    Right FilePath
p -> FilePath
p
    Left  FilePath
p -> FilePath
p

eitherRelativeTo
  :: FilePath                       -- ^ Anchor path, the prefix.
  -> FilePath                       -- ^ Make this relative to anchor path.
  -> Sh (Either FilePath FilePath)  -- ^ 'Left' is canonic of second path.
eitherRelativeTo :: FilePath -> FilePath -> Sh (Either FilePath FilePath)
eitherRelativeTo FilePath
relativeFP FilePath
fp = do
  let fullFp :: FilePath
fullFp = FilePath
relativeFP FilePath -> FilePath -> FilePath
FP.</> FilePath
fp
  let relDir :: FilePath
relDir = FilePath -> FilePath
addTrailingSlash FilePath
relativeFP
  FilePath
-> FilePath
-> Sh (Either FilePath FilePath)
-> Sh (Either FilePath FilePath)
stripIt FilePath
relativeFP FilePath
fp (Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath))
-> Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$
    FilePath
-> FilePath
-> Sh (Either FilePath FilePath)
-> Sh (Either FilePath FilePath)
stripIt FilePath
relativeFP FilePath
fullFp (Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath))
-> Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$
      FilePath
-> FilePath
-> Sh (Either FilePath FilePath)
-> Sh (Either FilePath FilePath)
stripIt FilePath
relDir FilePath
fp (Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath))
-> Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$
        FilePath
-> FilePath
-> Sh (Either FilePath FilePath)
-> Sh (Either FilePath FilePath)
stripIt FilePath
relDir FilePath
fullFp (Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath))
-> Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ do
          FilePath
relCan <- FilePath -> Sh FilePath
canonic FilePath
relDir
          FilePath
fpCan  <- FilePath -> Sh FilePath
canonic FilePath
fullFp
          FilePath
-> FilePath
-> Sh (Either FilePath FilePath)
-> Sh (Either FilePath FilePath)
stripIt FilePath
relCan FilePath
fpCan (Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath))
-> Sh (Either FilePath FilePath) -> Sh (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ Either FilePath FilePath -> Sh (Either FilePath FilePath)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath FilePath -> Sh (Either FilePath FilePath))
-> Either FilePath FilePath -> Sh (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
fpCan
  where
    stripIt
      :: FilePath
      -> FilePath
      -> Sh (Either FilePath FilePath)
      -> Sh (Either FilePath FilePath)
    stripIt :: FilePath
-> FilePath
-> Sh (Either FilePath FilePath)
-> Sh (Either FilePath FilePath)
stripIt FilePath
rel FilePath
toStrip Sh (Either FilePath FilePath)
nada =
      let stripped :: FilePath
stripped = FilePath -> FilePath -> FilePath
FP.makeRelative FilePath
rel FilePath
toStrip
      in if FilePath
stripped FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
toStrip
        then Sh (Either FilePath FilePath)
nada
        else Either FilePath FilePath -> Sh (Either FilePath FilePath)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath FilePath -> Sh (Either FilePath FilePath))
-> Either FilePath FilePath -> Sh (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
stripped

-- | Make the second path relative to the first.
-- Will canonicalize the paths if necessary.
relativeTo :: FilePath -- ^ Anchor path, the prefix.
           -> FilePath -- ^ Make this relative to anchor path.
           -> Sh FilePath
relativeTo :: FilePath -> FilePath -> Sh FilePath
relativeTo FilePath
relativeFP FilePath
fp =
  (Maybe FilePath -> FilePath) -> Sh (Maybe FilePath) -> Sh FilePath
forall a b. (a -> b) -> Sh a -> Sh b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
fp) (Sh (Maybe FilePath) -> Sh FilePath)
-> Sh (Maybe FilePath) -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Sh (Maybe FilePath)
maybeRelativeTo FilePath
relativeFP FilePath
fp

maybeRelativeTo :: FilePath  -- ^ Anchor path, the prefix.
                 -> FilePath -- ^ Make this relative to anchor path.
                 -> Sh (Maybe FilePath)
maybeRelativeTo :: FilePath -> FilePath -> Sh (Maybe FilePath)
maybeRelativeTo FilePath
relativeFP FilePath
fp = do
  Either FilePath FilePath
epath <- FilePath -> FilePath -> Sh (Either FilePath FilePath)
eitherRelativeTo FilePath
relativeFP FilePath
fp
  Maybe FilePath -> Sh (Maybe FilePath)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Sh (Maybe FilePath))
-> Maybe FilePath -> Sh (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ case Either FilePath FilePath
epath of
             Right FilePath
p -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
p
             Left FilePath
_ -> Maybe FilePath
forall a. Maybe a
Nothing


-- | Add a trailing slash to ensure the path indicates a directory.
addTrailingSlash :: FilePath -> FilePath
addTrailingSlash :: FilePath -> FilePath
addTrailingSlash = FilePath -> FilePath
FP.addTrailingPathSeparator

-- | Make an absolute path.
-- Like 'canonicalize', but on an exception returns 'absPath'.
canonic :: FilePath -> Sh FilePath
canonic :: FilePath -> Sh FilePath
canonic FilePath
fp = do
  FilePath
p <- FilePath -> Sh FilePath
absPath FilePath
fp
  IO FilePath -> Sh FilePath
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Sh FilePath) -> IO FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p IO FilePath -> (SomeException -> IO FilePath) -> IO FilePath
forall a. IO a -> (SomeException -> IO a) -> IO a
`catchany` \SomeException
_ -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
p

-- | Obtain a (reasonably) canonic file path to a filesystem object. Based on
-- 'canonicalizePath'.
canonicalize :: FilePath -> Sh FilePath
canonicalize :: FilePath -> Sh FilePath
canonicalize = FilePath -> Sh FilePath
absPath (FilePath -> Sh FilePath)
-> (FilePath -> Sh FilePath) -> FilePath -> Sh FilePath
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO FilePath -> Sh FilePath
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Sh FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> Sh FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
canonicalizePath

-- | Version of 'FS.canonicalizePath' that keeps a trailing slash.
canonicalizePath :: FilePath -> IO FilePath
canonicalizePath :: FilePath -> IO FilePath
canonicalizePath FilePath
p = let was_dir :: Bool
was_dir = FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> FilePath
FP.takeFileName FilePath
p) in
   if Bool -> Bool
not Bool
was_dir then FilePath -> IO FilePath
FS.canonicalizePath FilePath
p
     else FilePath -> FilePath
addTrailingSlash (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO FilePath
FS.canonicalizePath FilePath
p

data EmptyFilePathError = EmptyFilePathError deriving Typeable
instance Show EmptyFilePathError where
    show :: EmptyFilePathError -> FilePath
show EmptyFilePathError
_ = FilePath
"Empty filepath"
instance Exception EmptyFilePathError

-- | Make a relative path absolute by combining with the working directory.
-- An absolute path is returned as is.
-- To create a relative path, use 'relPath'.
absPath :: FilePath -> Sh FilePath
absPath :: FilePath -> Sh FilePath
absPath FilePath
p | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
p = IO FilePath -> Sh FilePath
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Sh FilePath) -> IO FilePath -> Sh FilePath
forall a b. (a -> b) -> a -> b
$ EmptyFilePathError -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO EmptyFilePathError
EmptyFilePathError
          | FilePath -> Bool
isRelative FilePath
p = do
            FilePath
cwd <-  (State -> FilePath) -> Sh FilePath
forall a. (State -> a) -> Sh a
gets State -> FilePath
sDirectory
            FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
cwd FilePath -> FilePath -> FilePath
FP.</> FilePath
p)
          | Bool
otherwise = FilePath -> Sh FilePath
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
p

path :: FilePath -> Sh FilePath
path :: FilePath -> Sh FilePath
path = FilePath -> Sh FilePath
absPath
{-# DEPRECATED path "use absPath, canonic, or relPath instead" #-}

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

-- | Does a path point to a symlink?
test_s :: FilePath -> Sh Bool
test_s :: FilePath -> Sh Bool
test_s = FilePath -> Sh FilePath
absPath (FilePath -> Sh FilePath)
-> (FilePath -> Sh Bool) -> FilePath -> Sh Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO Bool -> Sh Bool
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Sh Bool)
-> (FilePath -> IO Bool) -> FilePath -> Sh Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \FilePath
f -> do
  FileStatus
stat <- FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
f
  Bool -> IO Bool
forall a. a -> IO a
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 :: FilePath -> FilePath
unpack = FilePath -> FilePath
forall a. a -> a
id

gets :: (State -> a) -> Sh a
gets :: forall a. (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 a. IO a -> Sh a
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 a. IO a -> Sh a
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)

-- | Internally log what occurred.
-- Log will be re-played on failure.
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" }

-- | List directory contents. Does /not/ include @.@ and @..@, but it does
-- include (other) hidden files.
ls :: FilePath -> Sh [FilePath]
-- it is important to use path and not absPath so that the listing can remain relative
ls :: FilePath -> Sh [FilePath]
ls FilePath
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` FilePath -> Text
toTextIgnore FilePath
fp
  (([FilePath], [FilePath]) -> [FilePath])
-> Sh ([FilePath], [FilePath]) -> Sh [FilePath]
forall a b. (a -> b) -> Sh a -> Sh b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> a
fst (Sh ([FilePath], [FilePath]) -> Sh [FilePath])
-> Sh ([FilePath], [FilePath]) -> Sh [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Sh ([FilePath], [FilePath])
lsRelAbs FilePath
fp

lsRelAbs :: FilePath -> Sh ([FilePath], [FilePath])
lsRelAbs :: FilePath -> Sh ([FilePath], [FilePath])
lsRelAbs FilePath
f = FilePath -> Sh FilePath
absPath FilePath
f Sh FilePath
-> (FilePath -> Sh ([FilePath], [FilePath]))
-> Sh ([FilePath], [FilePath])
forall a b. Sh a -> (a -> Sh b) -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
fp -> do
  [FilePath]
files <- IO [FilePath] -> Sh [FilePath]
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Sh [FilePath]) -> IO [FilePath] -> Sh [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
fp
  let absolute :: [FilePath]
absolute = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
fp FilePath -> FilePath -> FilePath
FP.</>) [FilePath]
files
  let relativized :: [FilePath]
relativized = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
p -> [FilePath] -> FilePath
FP.joinPath [FilePath
f, FilePath
p]) [FilePath]
files
  ([FilePath], [FilePath]) -> Sh ([FilePath], [FilePath])
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
relativized, [FilePath]
absolute)

toTextIgnore :: FilePath -> Text
toTextIgnore :: FilePath -> Text
toTextIgnore = FilePath -> Text
T.pack

-- | 'print' lifted into 'Sh'.
inspect :: Show s => s -> Sh ()
inspect :: forall s. Show s => s -> Sh ()
inspect s
x = do
  Text -> Sh ()
trace (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
s
  IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn FilePath
s
  where s :: FilePath
s = s -> FilePath
forall a. Show a => a -> FilePath
show s
x

-- | A 'print' lifted into 'Sh' using stderr.
inspect_err :: Show s => s -> Sh ()
inspect_err :: forall s. Show s => s -> Sh ()
inspect_err s
x = do
  let shown :: Text
shown = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ s -> FilePath
forall a. Show a => a -> FilePath
show s
x
  Text -> Sh ()
trace Text
shown
  Text -> Sh ()
echo_err Text
shown

-- | Echo text to standard (error, when using @_err@ variants) output. The @_n@
-- variants do not print a final newline.
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 a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO ()
TIO.putStrLn Text
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO ()
TIO.putStr Text
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr Text
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 a b. Sh a -> Sh b -> Sh b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> Sh ()
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
TIO.hPutStr Handle
stderr Text
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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
"'")

-- | A helper to catch any exception (same as
-- @... `catch` \(e :: SomeException) -> ...@).
catchany :: IO a -> (SomeException -> IO a) -> IO a
catchany :: forall a. 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