module Path.Find
(findFileUp
,findDirUp
,findFiles
,findInParents)
where
import Stack.Prelude
import System.IO.Error (isPermissionError)
import Data.List
import Path
import Path.IO hiding (findFiles)
import System.PosixCompat.Files (getSymbolicLinkStatus, isSymbolicLink)
findFileUp :: (MonadIO m,MonadThrow m)
=> Path Abs Dir
-> (Path Abs File -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs File))
findFileUp = findPathUp snd
findDirUp :: (MonadIO m,MonadThrow m)
=> Path Abs Dir
-> (Path Abs Dir -> Bool)
-> Maybe (Path Abs Dir)
-> m (Maybe (Path Abs Dir))
findDirUp = findPathUp fst
findPathUp :: (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 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
findFiles :: Path Abs Dir
-> (Path Abs File -> Bool)
-> (Path Abs Dir -> Bool)
-> IO [Path Abs File]
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 :: 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