{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns      #-}

-- | Extra Path utilities.

module Path.Extra
  ( toFilePathNoTrailingSep
  , dropRoot
  , parseCollapsedAbsDir
  , parseCollapsedAbsFile
  , concatAndCollapseAbsDir
  , rejectMissingFile
  , rejectMissingDir
  , pathToByteString
  , pathToLazyByteString
  , pathToText
  , tryGetModificationTime
  , forgivingResolveDir
  , forgivingResolveFile
  , forgivingResolveFile'
  ) where

import           Data.Time ( UTCTime )
import           Path
                   ( Abs, Dir, File, PathException (..), Rel, parseAbsDir
                   , parseAbsFile, toFilePath
                   )
import           Path.Internal ( Path (Path) )
import           Path.IO
                   ( doesDirExist, doesFileExist, getCurrentDir
                   , getModificationTime
                   )
import           RIO
import           System.IO.Error ( isDoesNotExistError )
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified System.Directory as D
import qualified System.FilePath as FP

-- | Convert to FilePath but don't add a trailing slash.

toFilePathNoTrailingSep :: Path loc Dir -> FilePath
toFilePathNoTrailingSep :: forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep = FilePath -> FilePath
FP.dropTrailingPathSeparator (FilePath -> FilePath)
-> (Path loc Dir -> FilePath) -> Path loc Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path loc Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath

-- | Collapse intermediate "." and ".." directories from path, then parse

-- it with 'parseAbsDir'.

-- (probably should be moved to the Path module)

parseCollapsedAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir)
parseCollapsedAbsDir :: forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseCollapsedAbsDir = FilePath -> m (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir (FilePath -> m (Path Abs Dir))
-> (FilePath -> FilePath) -> FilePath -> m (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
collapseFilePath

-- | Collapse intermediate "." and ".." directories from path, then parse

-- it with 'parseAbsFile'.

-- (probably should be moved to the Path module)

parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File)
parseCollapsedAbsFile :: forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseCollapsedAbsFile = FilePath -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile (FilePath -> m (Path Abs File))
-> (FilePath -> FilePath) -> FilePath -> m (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
collapseFilePath

-- | Add a relative FilePath to the end of a Path

-- We can't parse the FilePath first because we need to account for ".."

-- in the FilePath (#2895)

concatAndCollapseAbsDir ::
     MonadThrow m
  => Path Abs Dir
  -> FilePath
  -> m (Path Abs Dir)
concatAndCollapseAbsDir :: forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> FilePath -> m (Path Abs Dir)
concatAndCollapseAbsDir Path Abs Dir
base FilePath
rel =
  FilePath -> m (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseCollapsedAbsDir (Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
base FilePath -> FilePath -> FilePath
FP.</> FilePath
rel)

-- | Collapse intermediate "." and ".." directories from a path.

--

-- > collapseFilePath "./foo" == "foo"

-- > collapseFilePath "/bar/../baz" == "/baz"

-- > collapseFilePath "/../baz" == "/../baz"

-- > collapseFilePath "parent/foo/baz/../bar" ==  "parent/foo/bar"

-- > collapseFilePath "parent/foo/baz/../../bar" ==  "parent/bar"

-- > collapseFilePath "parent/foo/.." ==  "parent"

-- > collapseFilePath "/parent/foo/../../bar" ==  "/bar"

--

-- (adapted from @Text.Pandoc.Shared@)

collapseFilePath :: FilePath -> FilePath
collapseFilePath :: FilePath -> FilePath
collapseFilePath = [FilePath] -> FilePath
FP.joinPath ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath] -> FilePath -> [FilePath])
-> [FilePath] -> [FilePath] -> [FilePath]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [FilePath] -> FilePath -> [FilePath]
go [] ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
FP.splitDirectories
 where
  go :: [FilePath] -> FilePath -> [FilePath]
go [FilePath]
rs FilePath
"." = [FilePath]
rs
  go r :: [FilePath]
r@(FilePath
p:[FilePath]
rs) FilePath
".." = case FilePath
p of
                          FilePath
".." -> FilePath
".."FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
r
                          (FilePath -> Bool
checkPathSeparator -> Bool
True) -> FilePath
".."FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
r
                          FilePath
_ -> [FilePath]
rs
  go [FilePath]
_ (FilePath -> Bool
checkPathSeparator -> Bool
True) = [[Char
FP.pathSeparator]]
  go [FilePath]
rs FilePath
x = FilePath
xFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
rs
  checkPathSeparator :: FilePath -> Bool
checkPathSeparator [Char
x] = Char -> Bool
FP.isPathSeparator Char
x
  checkPathSeparator FilePath
_ = Bool
False

-- | Drop the root (either @\/@ on POSIX or @C:\\@, @D:\\@, etc. on

-- Windows).

dropRoot :: Path Abs t -> Path Rel t
dropRoot :: forall t. Path Abs t -> Path Rel t
dropRoot (Path FilePath
l) = FilePath -> Path Rel t
forall b t. FilePath -> Path b t
Path (FilePath -> FilePath
FP.dropDrive FilePath
l)

-- | If given file in 'Maybe' does not exist, ensure we have 'Nothing'. This

-- is to be used in conjunction with 'forgivingAbsence' and

-- 'resolveFile'.

--

-- Previously the idiom @forgivingAbsence (resolveFile …)@ alone was used,

-- which relied on 'canonicalizePath' throwing 'isDoesNotExistError' when

-- path does not exist. As it turns out, this behavior is actually not

-- intentional and unreliable, see

-- <https://github.com/haskell/directory/issues/44>. This was “fixed” in

-- version @1.2.3.0@ of @directory@ package (now it never throws). To make

-- it work with all versions, we need to use the following idiom:

--

-- > forgivingAbsence (resolveFile …) >>= rejectMissingFile


rejectMissingFile ::
     MonadIO m
  => Maybe (Path Abs File)
  -> m (Maybe (Path Abs File))
rejectMissingFile :: forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile Maybe (Path Abs File)
Nothing = Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs File)
forall a. Maybe a
Nothing
rejectMissingFile (Just Path Abs File
p) = Maybe (Path Abs File)
-> Maybe (Path Abs File) -> Bool -> Maybe (Path Abs File)
forall a. a -> a -> Bool -> a
bool Maybe (Path Abs File)
forall a. Maybe a
Nothing (Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just Path Abs File
p) (Bool -> Maybe (Path Abs File))
-> m Bool -> m (Maybe (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs File -> m Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
p

-- | See 'rejectMissingFile'.


rejectMissingDir ::
     MonadIO m
  => Maybe (Path Abs Dir)
  -> m (Maybe (Path Abs Dir))
rejectMissingDir :: forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir))
rejectMissingDir Maybe (Path Abs Dir)
Nothing = Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs Dir)
forall a. Maybe a
Nothing
rejectMissingDir (Just Path Abs Dir
p) = Maybe (Path Abs Dir)
-> Maybe (Path Abs Dir) -> Bool -> Maybe (Path Abs Dir)
forall a. a -> a -> Bool -> a
bool Maybe (Path Abs Dir)
forall a. Maybe a
Nothing (Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
p) (Bool -> Maybe (Path Abs Dir))
-> m Bool -> m (Maybe (Path Abs Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs Dir -> m Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
p

-- | Convert to a lazy ByteString using toFilePath and UTF8.

pathToLazyByteString :: Path b t -> BSL.ByteString
pathToLazyByteString :: forall b t. Path b t -> ByteString
pathToLazyByteString = ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (Path b t -> ByteString) -> Path b t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> ByteString
forall b t. Path b t -> ByteString
pathToByteString

-- | Convert to a ByteString using toFilePath and UTF8.

pathToByteString :: Path b t -> BS.ByteString
pathToByteString :: forall b t. Path b t -> ByteString
pathToByteString = Text -> ByteString
T.encodeUtf8 (Text -> ByteString)
-> (Path b t -> Text) -> Path b t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> Text
forall b t. Path b t -> Text
pathToText

pathToText :: Path b t -> T.Text
pathToText :: forall b t. Path b t -> Text
pathToText = FilePath -> Text
T.pack (FilePath -> Text) -> (Path b t -> FilePath) -> Path b t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> FilePath
forall b t. Path b t -> FilePath
toFilePath

tryGetModificationTime :: MonadIO m => Path Abs File -> m (Either () UTCTime)
tryGetModificationTime :: forall (m :: * -> *).
MonadIO m =>
Path Abs File -> m (Either () UTCTime)
tryGetModificationTime =
  IO (Either () UTCTime) -> m (Either () UTCTime)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either () UTCTime) -> m (Either () UTCTime))
-> (Path Abs File -> IO (Either () UTCTime))
-> Path Abs File
-> m (Either () UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOError -> Maybe ()) -> IO UTCTime -> IO (Either () UTCTime)
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError) (IO UTCTime -> IO (Either () UTCTime))
-> (Path Abs File -> IO UTCTime)
-> Path Abs File
-> IO (Either () UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> IO UTCTime
forall (m :: * -> *) b t. MonadIO m => Path b t -> m UTCTime
getModificationTime

-- | 'Path.IO.resolveDir' (@path-io@ package) throws 'InvalidAbsDir' (@path@

-- package) if the directory does not exist; this function yields 'Nothing'.

forgivingResolveDir ::
     MonadIO m
  => Path Abs Dir
     -- ^ Base directory

  -> FilePath
     -- ^ Path to resolve

  -> m (Maybe (Path Abs Dir))
forgivingResolveDir :: forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs Dir))
forgivingResolveDir Path Abs Dir
b FilePath
p = IO (Maybe (Path Abs Dir)) -> m (Maybe (Path Abs Dir))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Path Abs Dir)) -> m (Maybe (Path Abs Dir)))
-> IO (Maybe (Path Abs Dir)) -> m (Maybe (Path Abs Dir))
forall a b. (a -> b) -> a -> b
$
  FilePath -> IO FilePath
D.canonicalizePath (Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
b FilePath -> FilePath -> FilePath
FP.</> FilePath
p) IO FilePath
-> (FilePath -> IO (Maybe (Path Abs Dir)))
-> IO (Maybe (Path Abs Dir))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
cp ->
    IO (Maybe (Path Abs Dir))
-> (PathException -> IO (Maybe (Path Abs Dir)))
-> IO (Maybe (Path Abs Dir))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
      (Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just (Path Abs Dir -> Maybe (Path Abs Dir))
-> IO (Path Abs Dir) -> IO (Maybe (Path Abs Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir FilePath
cp)
      ( \PathException
e -> case PathException
e of
          InvalidAbsDir FilePath
_ -> Maybe (Path Abs Dir) -> IO (Maybe (Path Abs Dir))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs Dir)
forall a. Maybe a
Nothing
          PathException
_ -> PathException -> IO (Maybe (Path Abs Dir))
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO PathException
e
      )

-- | 'Path.IO.resolveFile' (@path-io@ package) throws 'InvalidAbsFile' (@path@

-- package) if the file does not exist; this function yields 'Nothing'.

forgivingResolveFile ::
     MonadIO m
  => Path Abs Dir
     -- ^ Base directory

  -> FilePath
     -- ^ Path to resolve

  -> m (Maybe (Path Abs File))
forgivingResolveFile :: forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
forgivingResolveFile Path Abs Dir
b FilePath
p = IO (Maybe (Path Abs File)) -> m (Maybe (Path Abs File))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Path Abs File)) -> m (Maybe (Path Abs File)))
-> IO (Maybe (Path Abs File)) -> m (Maybe (Path Abs File))
forall a b. (a -> b) -> a -> b
$
  FilePath -> IO FilePath
D.canonicalizePath (Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
b FilePath -> FilePath -> FilePath
FP.</> FilePath
p) IO FilePath
-> (FilePath -> IO (Maybe (Path Abs File)))
-> IO (Maybe (Path Abs File))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
cp ->
    IO (Maybe (Path Abs File))
-> (PathException -> IO (Maybe (Path Abs File)))
-> IO (Maybe (Path Abs File))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
      (Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just (Path Abs File -> Maybe (Path Abs File))
-> IO (Path Abs File) -> IO (Maybe (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile FilePath
cp)
      ( \PathException
e -> case PathException
e of
          InvalidAbsFile FilePath
_ -> Maybe (Path Abs File) -> IO (Maybe (Path Abs File))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs File)
forall a. Maybe a
Nothing
          PathException
_ -> PathException -> IO (Maybe (Path Abs File))
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO PathException
e
      )

-- | 'Path.IO.resolveFile'' (@path-io@ package) throws 'InvalidAbsFile' (@path@

-- package) if the file does not exist; this function yields 'Nothing'.

forgivingResolveFile' ::
     MonadIO m
  => FilePath
     -- ^ Path to resolve

  -> m (Maybe (Path Abs File))
forgivingResolveFile' :: forall (m :: * -> *).
MonadIO m =>
FilePath -> m (Maybe (Path Abs File))
forgivingResolveFile' FilePath
p = m (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir m (Path Abs Dir)
-> (Path Abs Dir -> m (Maybe (Path Abs File)))
-> m (Maybe (Path Abs File))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Path Abs Dir -> FilePath -> m (Maybe (Path Abs File)))
-> FilePath -> Path Abs Dir -> m (Maybe (Path Abs File))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
forgivingResolveFile FilePath
p