{-# LANGUAGE OverloadedStrings #-}
module Shelly.Find
( find
, findWhen
, findFold
, findDirFilter
, findDirFilterWhen
, findFoldDirFilter
)
where
import Prelude hiding ( FilePath )
import Shelly.Base
import Control.Monad ( foldM )
import Data.Monoid ( mappend )
import System.PosixCompat.Files ( getSymbolicLinkStatus
, isSymbolicLink
)
import System.Directory ( doesDirectoryExist )
find :: FilePath -> Sh [FilePath]
find = findFold (\paths fp -> return $ paths ++ [fp]) []
findWhen :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath]
findWhen = findDirFilterWhen (const $ return True)
findFold :: (a -> FilePath -> Sh a) -> a -> FilePath -> Sh a
findFold folder startValue =
findFoldDirFilter folder startValue (const $ return True)
findDirFilter :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath]
findDirFilter filt = findDirFilterWhen filt (const $ return True)
findDirFilterWhen
:: (FilePath -> Sh Bool)
-> (FilePath -> Sh Bool)
-> FilePath
-> Sh [FilePath]
findDirFilterWhen dirFilt fileFilter = findFoldDirFilter filterIt [] dirFilt
where
filterIt paths fp = do
yes <- fileFilter fp
return $ if yes then paths ++ [fp] else paths
findFoldDirFilter
:: (a -> FilePath -> Sh a) -> a -> (FilePath -> Sh Bool) -> FilePath -> Sh a
findFoldDirFilter folder startValue dirFilter dir = do
absDir <- absPath dir
trace ("find " `mappend` toTextIgnore absDir)
files <- ls absDir
filt <- dirFilter absDir
if not filt
then return startValue
else do
(rPaths, aPaths) <- lsRelAbs dir
foldM traverse startValue (zip rPaths aPaths)
where
traverse acc (relativePath, absolutePath) = do
isDir <- liftIO $ doesDirectoryExist absolutePath
sym <- liftIO $ fmap isSymbolicLink $ getSymbolicLinkStatus absolutePath
newAcc <- folder acc relativePath
follow <- fmap sFollowSymlink get
if isDir && (follow || not sym)
then findFoldDirFilter folder newAcc dirFilter relativePath
else return newAcc