content: {-# LANGUAGE DataKinds #-}
  
  -- | Finding files.
  
  -- Lifted from Stack.
  
  module Path.Find
    (findFileUp
    ,findDirUp
    ,findFiles
    ,findInParents)
    where
  
  import Control.Exception (evaluate)
  import Control.DeepSeq (force)
  import Control.Monad
  import Control.Monad.Catch
  import Control.Monad.IO.Class
  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 = findPathUp 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 = findPathUp 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 pathType dir p upperBound =
    do entries <- listDir dir
       case find p (pathType entries) of
         Just path -> return (Just path)
         Nothing | Just dir == upperBound -> return Nothing
                 | parent dir == dir -> return Nothing
                 | otherwise -> findPathUp pathType (parent dir) p 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 dir p traversep =
    do (dirs,files) <- catchJust (\ e -> if isPermissionError e
                                           then Just ()
                                           else Nothing)
                                 (listDir dir)
                                 (\ _ -> return ([], []))
       filteredFiles <- evaluate $ force (filter p files)
       filteredDirs <- filterM (fmap not . isSymLink) dirs
       subResults <-
         forM filteredDirs
              (\entry ->
                 if traversep entry
                    then findFiles entry p traversep
                    else return [])
       return (concat (filteredFiles : subResults))
  
  isSymLink :: Path Abs t -> IO Bool
  isSymLink = fmap isSymbolicLink . getSymbolicLinkStatus . 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 f path = do
      mres <- f path
      case mres of
          Just res -> return (Just res)
          Nothing -> do
              let next = parent path
              if next == path
                  then return Nothing
                  else findInParents f next
  