{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns #-}
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
toFilePathNoTrailingSep :: Path loc Dir -> FilePath
toFilePathNoTrailingSep :: forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep = FilePath -> FilePath
FP.dropTrailingPathSeparator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath
parseCollapsedAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir)
parseCollapsedAbsDir :: forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseCollapsedAbsDir = forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
collapseFilePath
parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File)
parseCollapsedAbsFile :: forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseCollapsedAbsFile = forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
collapseFilePath
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 =
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseCollapsedAbsDir (forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
base FilePath -> FilePath -> FilePath
FP.</> FilePath
rel)
collapseFilePath :: FilePath -> FilePath
collapseFilePath :: FilePath -> FilePath
collapseFilePath = [FilePath] -> FilePath
FP.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [FilePath] -> FilePath -> [FilePath]
go [] 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
".."forall a. a -> [a] -> [a]
:[FilePath]
r
(FilePath -> Bool
checkPathSeparator -> Bool
True) -> 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
xforall a. a -> [a] -> [a]
:[FilePath]
rs
checkPathSeparator :: FilePath -> Bool
checkPathSeparator [Char
x] = Char -> Bool
FP.isPathSeparator Char
x
checkPathSeparator FilePath
_ = Bool
False
dropRoot :: Path Abs t -> Path Rel t
dropRoot :: forall t. Path Abs t -> Path Rel t
dropRoot (Path FilePath
l) = forall b t. FilePath -> Path b t
Path (FilePath -> FilePath
FP.dropDrive FilePath
l)
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
rejectMissingFile (Just Path Abs File
p) = forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Path Abs File
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
p
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
rejectMissingDir (Just Path Abs Dir
p) = forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Path Abs Dir
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
p
pathToLazyByteString :: Path b t -> BSL.ByteString
pathToLazyByteString :: forall b t. Path b t -> ByteString
pathToLazyByteString = ByteString -> ByteString
BSL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> ByteString
pathToByteString
pathToByteString :: Path b t -> BS.ByteString
pathToByteString :: forall b t. Path b t -> ByteString
pathToByteString = Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust (forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) b t. MonadIO m => Path b t -> m UTCTime
getModificationTime
forgivingResolveDir ::
MonadIO m
=> Path Abs Dir
-> FilePath
-> 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
FilePath -> IO FilePath
D.canonicalizePath (forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
b FilePath -> FilePath -> FilePath
FP.</> FilePath
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
cp ->
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
(forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir FilePath
cp)
( \PathException
e -> case PathException
e of
InvalidAbsDir FilePath
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
PathException
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO PathException
e
)
forgivingResolveFile ::
MonadIO m
=> Path Abs Dir
-> FilePath
-> 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
FilePath -> IO FilePath
D.canonicalizePath (forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
b FilePath -> FilePath -> FilePath
FP.</> FilePath
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
cp ->
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
(forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile FilePath
cp)
( \PathException
e -> case PathException
e of
InvalidAbsFile FilePath
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
PathException
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO PathException
e
)
forgivingResolveFile' ::
MonadIO m
=> FilePath
-> m (Maybe (Path Abs File))
forgivingResolveFile' :: forall (m :: * -> *).
MonadIO m =>
FilePath -> m (Maybe (Path Abs File))
forgivingResolveFile' FilePath
p = forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
forgivingResolveFile FilePath
p