{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
module Path.Find
( findFileUp
, findDirUp
, findFiles
, findInParents
) where
import qualified Data.List as L
import Path
import Path.IO hiding (findFiles)
import RIO
import System.IO.Error ( isPermissionError )
import System.PosixCompat.Files
( getSymbolicLinkStatus, isSymbolicLink )
findFileUp :: (MonadIO m,MonadThrow m)
=> Path Abs Dir
-> (Path Abs File -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs File))
findFileUp :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir
-> (Path Abs File -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs File))
findFileUp = forall (m :: * -> *) t.
(MonadIO m, MonadThrow m) =>
(([Path Abs Dir], [Path Abs File]) -> [Path Abs t])
-> Path Abs Dir
-> (Path Abs t -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs t))
findPathUp forall a b. (a, b) -> b
snd
findDirUp :: (MonadIO m,MonadThrow m)
=> Path Abs Dir
-> (Path Abs Dir -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs Dir))
findDirUp :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir
-> (Path Abs Dir -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs Dir))
findDirUp = forall (m :: * -> *) t.
(MonadIO m, MonadThrow m) =>
(([Path Abs Dir], [Path Abs File]) -> [Path Abs t])
-> Path Abs Dir
-> (Path Abs t -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs t))
findPathUp forall a b. (a, b) -> a
fst
findPathUp :: (MonadIO m,MonadThrow m)
=> (([Path Abs Dir],[Path Abs File]) -> [Path Abs t])
-> Path Abs Dir
-> (Path Abs t -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs t))
findPathUp :: forall (m :: * -> *) t.
(MonadIO m, MonadThrow m) =>
(([Path Abs Dir], [Path Abs File]) -> [Path Abs t])
-> Path Abs Dir
-> (Path Abs t -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs t))
findPathUp ([Path Abs Dir], [Path Abs File]) -> [Path Abs t]
pathType Path Abs Dir
dir Path Abs t -> Bool
p Maybe (Path Abs Dir)
upperBound =
do ([Path Abs Dir], [Path Abs File])
entries <- forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir
case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find Path Abs t -> Bool
p (([Path Abs Dir], [Path Abs File]) -> [Path Abs t]
pathType ([Path Abs Dir], [Path Abs File])
entries) of
Just Path Abs t
path -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Path Abs t
path)
Maybe (Path Abs t)
Nothing | forall a. a -> Maybe a
Just Path Abs Dir
dir forall a. Eq a => a -> a -> Bool
== Maybe (Path Abs Dir)
upperBound -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
| forall b t. Path b t -> Path b Dir
parent Path Abs Dir
dir forall a. Eq a => a -> a -> Bool
== Path Abs Dir
dir -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
| Bool
otherwise -> forall (m :: * -> *) t.
(MonadIO m, MonadThrow m) =>
(([Path Abs Dir], [Path Abs File]) -> [Path Abs t])
-> Path Abs Dir
-> (Path Abs t -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs t))
findPathUp ([Path Abs Dir], [Path Abs File]) -> [Path Abs t]
pathType (forall b t. Path b t -> Path b Dir
parent Path Abs Dir
dir) Path Abs t -> Bool
p Maybe (Path Abs Dir)
upperBound
findFiles :: Path Abs Dir
-> (Path Abs File -> Bool)
-> (Path Abs Dir -> Bool)
-> IO [Path Abs File]
findFiles :: Path Abs Dir
-> (Path Abs File -> Bool)
-> (Path Abs Dir -> Bool)
-> IO [Path Abs File]
findFiles Path Abs Dir
dir Path Abs File -> Bool
p Path Abs Dir -> Bool
traversep =
do ([Path Abs Dir]
dirs,[Path Abs File]
files) <- forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust (\ IOError
e -> if IOError -> Bool
isPermissionError IOError
e
then forall a. a -> Maybe a
Just ()
else forall a. Maybe a
Nothing)
(forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir)
(\ ()
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], []))
[Path Abs File]
filteredFiles <- forall (m :: * -> *) a. MonadIO m => a -> m a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> a
force (forall a. (a -> Bool) -> [a] -> [a]
filter Path Abs File -> Bool
p [Path Abs File]
files)
[Path Abs Dir]
filteredDirs <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Path Abs t -> IO Bool
isSymLink) [Path Abs Dir]
dirs
[[Path Abs File]]
subResults <-
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Abs Dir]
filteredDirs
(\Path Abs Dir
entry ->
if Path Abs Dir -> Bool
traversep Path Abs Dir
entry
then Path Abs Dir
-> (Path Abs File -> Bool)
-> (Path Abs Dir -> Bool)
-> IO [Path Abs File]
findFiles Path Abs Dir
entry Path Abs File -> Bool
p Path Abs Dir -> Bool
traversep
else forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Path Abs File]
filteredFiles forall a. a -> [a] -> [a]
: [[Path Abs File]]
subResults))
isSymLink :: Path Abs t -> IO Bool
isSymLink :: forall t. Path Abs t -> IO Bool
isSymLink = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileStatus -> Bool
isSymbolicLink forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
getSymbolicLinkStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath
findInParents :: MonadIO m => (Path Abs Dir -> m (Maybe a)) -> Path Abs Dir -> m (Maybe a)
findInParents :: forall (m :: * -> *) a.
MonadIO m =>
(Path Abs Dir -> m (Maybe a)) -> Path Abs Dir -> m (Maybe a)
findInParents Path Abs Dir -> m (Maybe a)
f Path Abs Dir
path = do
Maybe a
mres <- Path Abs Dir -> m (Maybe a)
f Path Abs Dir
path
case Maybe a
mres of
Just a
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
res)
Maybe a
Nothing -> do
let next :: Path Abs Dir
next = forall b t. Path b t -> Path b Dir
parent Path Abs Dir
path
if Path Abs Dir
next forall a. Eq a => a -> a -> Bool
== Path Abs Dir
path
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall (m :: * -> *) a.
MonadIO m =>
(Path Abs Dir -> m (Maybe a)) -> Path Abs Dir -> m (Maybe a)
findInParents Path Abs Dir -> m (Maybe a)
f Path Abs Dir
next