{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}

-- | Finding files.

module Path.Find
  (findFileUp
  ,findDirUp
  ,findFiles
  ,findInParents)
  where

import RIO
import System.IO.Error (isPermissionError)
import Data.List
import Path
import Path.IO hiding (findFiles)
import System.PosixCompat.Files (getSymbolicLinkStatus, isSymbolicLink)

-- | Find the location of a file matching the given predicate.
findFileUp :: (MonadIO m,MonadThrow m)
           => Path Abs Dir                -- ^ Start here.
           -> (Path Abs File -> Bool)     -- ^ Predicate to match the file.
           -> Maybe (Path Abs Dir)        -- ^ Do not ascend above this directory.
           -> m (Maybe (Path Abs File))  -- ^ Absolute file path.
findFileUp :: Path Abs Dir
-> (Path Abs File -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs File))
findFileUp = (([Path Abs Dir], [Path Abs File]) -> [Path Abs File])
-> Path Abs Dir
-> (Path Abs File -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs File))
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 File]
forall a b. (a, b) -> b
snd

-- | Find the location of a directory matching the given predicate.
findDirUp :: (MonadIO m,MonadThrow m)
          => Path Abs Dir                -- ^ Start here.
          -> (Path Abs Dir -> Bool)      -- ^ Predicate to match the directory.
          -> Maybe (Path Abs Dir)        -- ^ Do not ascend above this directory.
          -> m (Maybe (Path Abs Dir))   -- ^ Absolute directory path.
findDirUp :: Path Abs Dir
-> (Path Abs Dir -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs Dir))
findDirUp = (([Path Abs Dir], [Path Abs File]) -> [Path Abs Dir])
-> Path Abs Dir
-> (Path Abs Dir -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs Dir))
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 Dir]
forall a b. (a, b) -> a
fst

-- | Find the location of a path matching the given predicate.
findPathUp :: (MonadIO m,MonadThrow m)
           => (([Path Abs Dir],[Path Abs File]) -> [Path Abs t])
              -- ^ Choose path type from pair.
           -> Path Abs Dir                     -- ^ Start here.
           -> (Path Abs t -> Bool)             -- ^ Predicate to match the path.
           -> Maybe (Path Abs Dir)             -- ^ Do not ascend above this directory.
           -> m (Maybe (Path Abs t))           -- ^ Absolute path.
findPathUp :: (([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 <- Path Abs Dir -> m ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir
     case (Path Abs t -> Bool) -> [Path Abs t] -> Maybe (Path Abs t)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
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 -> Maybe (Path Abs t) -> m (Maybe (Path Abs t))
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs t -> Maybe (Path Abs t)
forall a. a -> Maybe a
Just Path Abs t
path)
       Maybe (Path Abs t)
Nothing | Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
dir Maybe (Path Abs Dir) -> Maybe (Path Abs Dir) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Path Abs Dir)
upperBound -> Maybe (Path Abs t) -> m (Maybe (Path Abs t))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Path Abs t)
forall a. Maybe a
Nothing
               | Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
dir Path Abs Dir -> Path Abs Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Path Abs Dir
dir -> Maybe (Path Abs t) -> m (Maybe (Path Abs t))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Path Abs t)
forall a. Maybe a
Nothing
               | Bool
otherwise -> (([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))
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 -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
dir) Path Abs t -> Bool
p Maybe (Path Abs Dir)
upperBound

-- | Find files matching predicate below a root directory.
--
-- NOTE: this skips symbolic directory links, to avoid loops. This may
-- not make sense for all uses of file finding.
--
-- TODO: write one of these that traverses symbolic links but
-- efficiently ignores loops.
findFiles :: Path Abs Dir            -- ^ Root directory to begin with.
          -> (Path Abs File -> Bool) -- ^ Predicate to match files.
          -> (Path Abs Dir -> Bool)  -- ^ Predicate for which directories to traverse.
          -> IO [Path Abs File]      -- ^ List of matching files.
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) <- (IOError -> Maybe ())
-> IO ([Path Abs Dir], [Path Abs File])
-> (() -> IO ([Path Abs Dir], [Path Abs File]))
-> IO ([Path Abs Dir], [Path Abs File])
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 () -> Maybe ()
forall a. a -> Maybe a
Just ()
                                         else Maybe ()
forall a. Maybe a
Nothing)
                               (Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir)
                               (\ ()
_ -> ([Path Abs Dir], [Path Abs File])
-> IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], []))
     [Path Abs File]
filteredFiles <- [Path Abs File] -> IO [Path Abs File]
forall (m :: * -> *) a. MonadIO m => a -> m a
evaluate ([Path Abs File] -> IO [Path Abs File])
-> [Path Abs File] -> IO [Path Abs File]
forall a b. (a -> b) -> a -> b
$ [Path Abs File] -> [Path Abs File]
forall a. NFData a => a -> a
force ((Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
forall a. (a -> Bool) -> [a] -> [a]
filter Path Abs File -> Bool
p [Path Abs File]
files)
     [Path Abs Dir]
filteredDirs <- (Path Abs Dir -> IO Bool) -> [Path Abs Dir] -> IO [Path Abs Dir]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (IO Bool -> IO Bool)
-> (Path Abs Dir -> IO Bool) -> Path Abs Dir -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> IO Bool
forall t. Path Abs t -> IO Bool
isSymLink) [Path Abs Dir]
dirs
     [[Path Abs File]]
subResults <-
       [Path Abs Dir]
-> (Path Abs Dir -> IO [Path Abs File]) -> IO [[Path Abs File]]
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 [Path Abs File] -> IO [Path Abs File]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
     [Path Abs File] -> IO [Path Abs File]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Path Abs File]] -> [Path Abs File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Path Abs File]
filteredFiles [Path Abs File] -> [[Path Abs File]] -> [[Path Abs File]]
forall a. a -> [a] -> [a]
: [[Path Abs File]]
subResults))

isSymLink :: Path Abs t -> IO Bool
isSymLink :: Path Abs t -> IO Bool
isSymLink = (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileStatus -> Bool
isSymbolicLink (IO FileStatus -> IO Bool)
-> (Path Abs t -> IO FileStatus) -> Path Abs t -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
getSymbolicLinkStatus (FilePath -> IO FileStatus)
-> (Path Abs t -> FilePath) -> Path Abs t -> IO FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs t -> FilePath
forall b t. Path b t -> FilePath
toFilePath

-- | @findInParents f path@ applies @f@ to @path@ and its 'parent's until
-- it finds a 'Just' or reaches the root directory.
findInParents :: MonadIO m => (Path Abs Dir -> m (Maybe a)) -> Path Abs Dir -> m (Maybe a)
findInParents :: (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 -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
res)
        Maybe a
Nothing -> do
            let next :: Path Abs Dir
next = Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
path
            if Path Abs Dir
next Path Abs Dir -> Path Abs Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Path Abs Dir
path
                then Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                else (Path Abs Dir -> m (Maybe a)) -> Path Abs Dir -> m (Maybe a)
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