{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE ViewPatterns #-}

-- | Extra Path utilities.

module Path.Extra

(toFilePathNoTrailingSep

,dropRoot

,parseCollapsedAbsDir

,parseCollapsedAbsFile

,concatAndColapseAbsDir

,rejectMissingFile

,rejectMissingDir

,pathToByteString

,pathToLazyByteString

,pathToText

,tryGetModificationTime

) where

import Data.Bool (bool)

import Data.Time (UTCTime)

import Path

import Path.IO

import Path.Internal (Path(..))

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.FilePath as FP

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

toFilePathNoTrailingSep :: Path loc Dir -> FilePath

toFilePathNoTrailingSep = FP.dropTrailingPathSeparator . 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 = parseAbsDir . 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 = parseAbsFile . 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)

concatAndColapseAbsDir :: MonadThrow m => Path Abs Dir -> FilePath -> m (Path Abs Dir)

concatAndColapseAbsDir base rel = parseCollapsedAbsDir (toFilePath base FP.</> 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 = FP.joinPath . reverse . foldl' go [] . FP.splitDirectories

where

go rs "." = rs

go r@(p:rs) ".." = case p of

".." -> "..":r

(checkPathSeparator -> True) -> "..":r

_ -> rs

go _ (checkPathSeparator -> True) = [[FP.pathSeparator]]

go rs x = x:rs

checkPathSeparator [x] = FP.isPathSeparator x

checkPathSeparator _ = False

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

-- Windows).

dropRoot :: Path Abs t -> Path Rel t

dropRoot (Path l) = Path (FP.dropDrive 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 (relsoveFile …)@ 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 Nothing = return Nothing

rejectMissingFile (Just p) = bool Nothing (Just p) `liftM` doesFileExist p

-- | See 'rejectMissingFile'.

rejectMissingDir :: MonadIO m

=> Maybe (Path Abs Dir)

-> m (Maybe (Path Abs Dir))

rejectMissingDir Nothing = return Nothing

rejectMissingDir (Just p) = bool Nothing (Just p) `liftM` doesDirExist p

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

pathToLazyByteString :: Path b t -> BSL.ByteString

pathToLazyByteString = BSL.fromStrict . pathToByteString

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

pathToByteString :: Path b t -> BS.ByteString

pathToByteString = T.encodeUtf8 . pathToText

pathToText :: Path b t -> T.Text

pathToText = T.pack . toFilePath

tryGetModificationTime :: MonadIO m => Path Abs File -> m (Either () UTCTime)

tryGetModificationTime = liftIO . tryJust (guard . isDoesNotExistError) . getModificationTime