{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns #-}
module Path.Extra
(toFilePathNoTrailingSep
,dropRoot
,parseCollapsedAbsDir
,parseCollapsedAbsFile
,concatAndColapseAbsDir
,rejectMissingFile
,rejectMissingDir
,pathToByteString
,pathToLazyByteString
,pathToText
,tryGetModificationTime
) where
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