{-# LANGUAGE NoImplicitPrelude #-}

{-|
Module      : Path.Find
Description : Finding files.
License     : BSD-3-Clause

Finding files.
-}

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

import qualified Data.List as L
import           Path ( Abs, Dir, File, Path, parent, toFilePath )
import           Path.IO ( listDir )
import           RIO
import           System.IO.Error ( isPermissionError )
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 :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
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 :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
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 :: 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
  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 L.find p (pathType entries) of
    Just Path Abs t
path -> Maybe (Path Abs t) -> m (Maybe (Path Abs t))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
  (dirs,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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], []))
  filteredFiles <- evaluate $ force (filter p files)
  filteredDirs <- filterM (fmap not . isSymLink) dirs
  subResults <-
    forM 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
  pure (concat (filteredFiles : subResults))

isSymLink :: Path Abs t -> IO Bool
isSymLink :: forall t. Path Abs t -> IO Bool
isSymLink = (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
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 :: 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 = Path Abs Dir -> m (Maybe a)
f Path Abs Dir
path m (Maybe a) -> (Maybe a -> m (Maybe a)) -> m (Maybe a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just a
res -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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