module Data.Conduit.Find
( FileEntry(..)
, Predicate(..)
, sourceFileEntries
, matchAll
, ignoreVcs
, regexMatcher
, regex
, glob
) where
import Conduit
import Control.Applicative
import Control.Monad (when)
import Data.Attoparsec.Text
import Data.Foldable (for_)
import Data.Monoid ((<>), mconcat)
import Data.Text (Text, unpack, pack)
import Filesystem.Path.CurrentOS (FilePath, encodeString, filename)
import Prelude hiding (FilePath)
import System.Posix.Files (FileStatus, getFileStatus, getSymbolicLinkStatus,
isDirectory)
import Text.Regex.Posix ((=~))
data FileEntry = FileEntry
{ entryPath :: FilePath
, entryStatus :: FileStatus
}
newtype Predicate m =
Predicate (FileEntry -> m (Maybe FileEntry, Maybe (Predicate m)))
sourceFileEntries :: MonadResource m
=> Bool -> Predicate m -> FilePath -> Producer m FileEntry
sourceFileEntries followSymlinks (Predicate matcher) dir =
sourceDirectory dir =$= go
where
go = do
mfp <- await
for_ mfp $ \fp -> do
stat <- liftIO $
(if followSymlinks
then getFileStatus
else getSymbolicLinkStatus)
(encodeString fp)
let entry = FileEntry fp stat
res <- lift $ matcher entry
for_ (fst res) yield
when (isDirectory stat) $
for_ (snd res) $
flip (sourceFileEntries followSymlinks) fp
go
matchAll :: Monad m => Predicate m
matchAll = Predicate $ \entry -> return (Just entry, Just matchAll)
ignoreVcs :: MonadIO m => Predicate m
ignoreVcs = Predicate $ \entry ->
return $ if filename (entryPath entry) `elem` vcsDirs
then (Nothing, Nothing)
else (Just entry, Just ignoreVcs)
where
vcsDirs = [ ".git", "CVS", "RCS", "SCCS", ".svn", ".hg" ]
regexMatcher :: Monad m
=> (FilePath -> FilePath)
-> Bool
-> Text
-> Predicate m
regexMatcher accessor pruneNonMatching (unpack -> pat) = go
where
go = Predicate $ \entry ->
return $ if encodeString (accessor (entryPath entry)) =~ pat
then (Just entry, Just go)
else (Nothing, if pruneNonMatching
then Nothing
else Just go)
regex :: Monad m => Text -> Predicate m
regex = regexMatcher filename False
glob :: Monad m => Text -> Predicate m
glob g = case parseOnly globParser g of
Left e -> error $ "Failed to parse glob: " ++ e
Right x -> regex ("^" <> x <> "$")
where
globParser :: Parser Text
globParser = fmap mconcat $ many $
char '*' *> return ".*"
<|> char '?' *> return "."
<|> (\x y z -> pack ((x:y) ++ [z]))
<$> char '['
<*> manyTill anyChar (try (char ']'))
<*> char ']'
<|> do
x <- anyChar
return . pack $ if x `elem` ['.', '(', ')', '^', '$']
then ['\\', x]
else [x]