{-# LANGUAGE DataKinds #-}

-- | Finding files.
-- Lifted from Stack.
module Path.Find
  ( findFileUp
  ) where

import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.List
import Path
import Path.IO

-- | 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 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