{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns #-}
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
toFilePathNoTrailingSep :: Path loc Dir -> FilePath
toFilePathNoTrailingSep = FP.dropTrailingPathSeparator . toFilePath
parseCollapsedAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir)
parseCollapsedAbsDir = parseAbsDir . collapseFilePath
parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File)
parseCollapsedAbsFile = parseAbsFile . collapseFilePath
concatAndColapseAbsDir :: MonadThrow m => Path Abs Dir -> FilePath -> m (Path Abs Dir)
concatAndColapseAbsDir base rel = parseCollapsedAbsDir (toFilePath base FP.</> rel)
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
dropRoot :: Path Abs t -> Path Rel t
dropRoot (Path l) = Path (FP.dropDrive l)
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
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
pathToLazyByteString :: Path b t -> BSL.ByteString
pathToLazyByteString = BSL.fromStrict . pathToByteString
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