{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}

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

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706
import Prelude hiding (FilePath, catch)
#else
import Prelude hiding (FilePath)
#endif

import Data.Text (Text)
import System.Process( ProcessHandle, StdStream(..) )
import System.IO ( Handle, hFlush, stderr, stdout )

import Control.Monad (when, (>=>),
         liftM
       )
import Control.Monad.Fail (MonadFail)
import qualified Control.Monad.Fail as Fail
import Control.Monad.Base
import Control.Monad.Trans.Control
import Control.Applicative (Applicative, (<$>))
import Filesystem (isDirectory, listDirectory)
import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink )
import Filesystem.Path.CurrentOS (FilePath, encodeString, relative)
import qualified Filesystem.Path.CurrentOS as FP
import qualified Filesystem as FS
import Data.IORef (readIORef, modifyIORef, IORef)
import Data.Monoid (mappend)
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 ((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
<$ :: forall a b. a -> Sh b -> Sh a
$c<$ :: forall a b. a -> Sh b -> Sh a
fmap :: forall a b. (a -> b) -> Sh a -> Sh b
$cfmap :: forall a b. (a -> b) -> Sh a -> Sh b
Functor, 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
<* :: forall a b. Sh a -> Sh b -> Sh a
$c<* :: forall a b. Sh a -> Sh b -> Sh a
*> :: forall a b. Sh a -> Sh b -> Sh b
$c*> :: forall a b. Sh a -> Sh b -> Sh b
liftA2 :: forall a b c. (a -> b -> c) -> Sh a -> Sh b -> Sh c
$cliftA2 :: forall a b c. (a -> b -> c) -> Sh a -> Sh b -> Sh c
<*> :: forall a b. Sh (a -> b) -> Sh a -> Sh b
$c<*> :: forall a b. Sh (a -> b) -> Sh a -> Sh b
pure :: forall a. a -> Sh a
$cpure :: forall a. a -> 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
return :: forall a. a -> Sh a
$creturn :: forall a. a -> Sh a
>> :: forall a b. Sh a -> Sh b -> Sh b
$c>> :: forall a b. Sh a -> Sh b -> Sh b
>>= :: forall a b. Sh a -> (a -> Sh b) -> Sh b
$c>>= :: forall a b. Sh a -> (a -> Sh b) -> Sh b
Monad, 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
liftIO :: forall a. IO a -> Sh a
$cliftIO :: forall a. IO a -> Sh a
MonadIO, MonadReader (IORef State), 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
generalBracket :: forall a b c.
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 b. ((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 b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
$cmask :: forall b. ((forall a. Sh a -> Sh a) -> Sh b) -> Sh b
Catch.MonadMask) --, MonadFail)

-- Andreas Abel, 2022-03-24
-- For reasons unclear to me, GHC 7.10 does not derive the MonadFail instance
-- from the instances for IO and ReaderT.  Starts working with GHC 8.0.
instance MonadFail Sh where
    fail :: forall a. String -> Sh a
fail = ReaderT (IORef State) IO a -> Sh a
forall a. ReaderT (IORef State) IO a -> Sh a
Sh (ReaderT (IORef State) IO a -> Sh a)
-> (String -> ReaderT (IORef State) IO a) -> String -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (String -> IORef State -> IO a)
-> String
-> ReaderT (IORef State) IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IORef State -> IO a
forall a b. a -> b -> a
const (IO a -> IORef State -> IO a)
-> (String -> IO a) -> String -> IORef State -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail

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 (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
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 (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 :: 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 (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 -> [(String, String)]
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 (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 (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)
forall {m :: * -> *} {a}.
Monad m =>
FilePath
-> FilePath -> m (Either a FilePath) -> m (Either a 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)
forall {m :: * -> *} {a}.
Monad m =>
FilePath
-> FilePath -> m (Either a FilePath) -> m (Either a 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)
forall {m :: * -> *} {a}.
Monad m =>
FilePath
-> FilePath -> m (Either a FilePath) -> m (Either a 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)
forall {m :: * -> *} {a}.
Monad m =>
FilePath
-> FilePath -> m (Either a FilePath) -> m (Either a 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)
forall {m :: * -> *} {a}.
Monad m =>
FilePath
-> FilePath -> m (Either a FilePath) -> m (Either a 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 (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 -> m (Either a FilePath) -> m (Either a FilePath)
stripIt FilePath
rel FilePath
toStrip m (Either a FilePath)
nada =
      case FilePath -> FilePath -> Maybe FilePath
FP.stripPrefix FilePath
rel FilePath
toStrip of
        Just FilePath
stripped ->
          if FilePath
stripped FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
toStrip then m (Either a FilePath)
nada
            else Either a FilePath -> m (Either a FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a FilePath -> m (Either a FilePath))
-> Either a FilePath -> m (Either a FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either a FilePath
forall a b. b -> Either a b
Right FilePath
stripped
        Maybe FilePath
Nothing -> m (Either a FilePath)
nada

-- | make the second path relative to the first
-- Uses 'Filesystem.stripPrefix', but 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 (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 (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
p =
  if FilePath -> Bool
FP.null (FilePath -> FilePath
FP.filename FilePath
p) then FilePath
p else
    FilePath
p FilePath -> FilePath -> FilePath
FP.</> FilePath
FP.empty

-- | makes 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 (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 (m :: * -> *) a. Monad m => a -> m a
return FilePath
p

-- | Obtain a (reasonably) canonic file path to a filesystem object. Based on
-- "canonicalizePath" in system-fileio.
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 (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

-- | bugfix older version of canonicalizePath (system-fileio <= 0.3.7) loses trailing slash
canonicalizePath :: FilePath -> IO FilePath
canonicalizePath :: FilePath -> IO FilePath
canonicalizePath FilePath
p = let was_dir :: Bool
was_dir = FilePath -> Bool
FP.null (FilePath -> FilePath
FP.filename 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 (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 -> String
show EmptyFilePathError
_ = String
"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
FP.null FilePath
p = IO FilePath -> Sh FilePath
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
relative FilePath
p = (FilePath -> FilePath -> FilePath
FP.</> FilePath
p) (FilePath -> FilePath) -> Sh FilePath -> Sh FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (State -> FilePath) -> Sh FilePath
forall a. (State -> a) -> Sh a
gets State -> FilePath
sDirectory
          | Bool
otherwise = FilePath -> Sh FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
p

-- | deprecated
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 (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
isDirectory

-- | 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 (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 <- String -> IO FileStatus
getSymbolicLinkStatus (FilePath -> String
encodeString FilePath
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 :: FilePath -> String
unpack = FilePath -> String
encodeString

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 (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)

-- | 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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
fp -> do
  FilePath -> Sh FilePath
filt <- if Bool -> Bool
not (FilePath -> Bool
relative FilePath
f) then (FilePath -> Sh FilePath) -> Sh (FilePath -> Sh FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath -> Sh FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return
             else do
               FilePath
wd <- (State -> FilePath) -> Sh FilePath
forall a. (State -> a) -> Sh a
gets State -> FilePath
sDirectory
               (FilePath -> Sh FilePath) -> Sh (FilePath -> Sh FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath -> Sh FilePath
relativeTo FilePath
wd)
  [FilePath]
absolute <- IO [FilePath] -> Sh [FilePath]
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
  [FilePath]
relativized <- (FilePath -> Sh FilePath) -> [FilePath] -> Sh [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> Sh FilePath
filt [FilePath]
absolute
  ([FilePath], [FilePath]) -> Sh ([FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
relativized, [FilePath]
absolute)

-- | silently uses the Right or Left value of "Filesystem.Path.CurrentOS.toText"
toTextIgnore :: FilePath -> Text
toTextIgnore :: FilePath -> Text
toTextIgnore FilePath
fp = case FilePath -> Either Text Text
FP.toText FilePath
fp of
                    Left  Text
f -> Text
f
                    Right Text
f -> Text
f

-- | a 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 ()) -> (s -> Text) -> s -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Show a => a -> String
show) s
x
  IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ s -> IO ()
forall a. Show a => a -> IO ()
print 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 = 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 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 (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
"'")

-- | 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