Find.hs

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

-- | 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 = 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 L.find p (pathType entries) of
    Just path -> pure (Just path)
    Nothing | Just dir == upperBound -> pure Nothing
            | parent dir == dir -> pure 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)
                            (\ _ -> pure ([], []))
  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 pure [])
  pure (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 -> pure (Just res)
    Nothing -> do
      let next = parent path
      if next == path
        then pure Nothing
        else findInParents f next