conduit-find-0.1.0.4: A file-finding conduit that allows user control over traversals.
Safe HaskellNone
LanguageHaskell2010

Data.Conduit.Find

Synopsis

Introduction

  • *find-conduit** is essentially a souped version of GNU find for Haskell, using a DSL to provide both ease of us, and extensive flexbility.

In its simplest form, let's compare some uses of find to find-conduit. Bear in mind that the result of the find function is a conduit, so you're expected to either sink it to a list, or operate on the file paths as they are yielded.

Basic comparison with GNU find

A typical find command:

find src -name '*.hs' -type f -print

Would in find-conduit be:

find "src" (glob "*.hs" <> regular) $$ mapM_C (liftIO . print)

The glob predicate matches the file basename against the globbing pattern, while the regular predicate matches plain files.

A more complicated example:

find . -size +100M -perm 644 -mtime 1

Now in find-conduit:

let megs = 1024 * 1024
    days = 86400
now <- liftIO getCurrentTime
find "." ( fileSize (> 100*megs)
        <> hasMode 0o644
        <> lastModified (> addUTCTime now (-(1*days)))
         )

Appending predicates like this expressing an "and" relationship. Use <|> to express "or". You can also negate any predicate:

find "." (not_ (hasMode 0o644))

By default, predicates, whether matching or not, will allow recursion into directories. In order to express that matching predicate should disallow recursion, use prune:

find "." (prune (depth (> 2)))

This is the same as using '-maxdepth 2' in find.

find "." (prune (filename_ (== "dist")))

This is the same as:

find . \( -name dist -prune \) -o -print

Performance

find-conduit strives to make file-finding a well performing operation. To this end, a composed Predicate will only call stat once per entry being considered; and if you prune a directory, it is not traversed at all.

By default, find calls stat for every file before it applies the predicate, in order to ensure that only one such call is needed. Sometimes, however, you know just from the FilePath that you don't want to consider a certain file, or you want to prune a directory tree.

To support these types of optimized queries, a variant of find is provided called findWithPreFilter. This takes two predicates: one that is applied to only the FilePath, before stat (or lstat) is called; and one that is applied to the full file information after the stat.

Other notes

See Cond for more details on the Monad used to build predicates.

Finding functions

sourceFindFiles :: forall (m :: Type -> Type) a i. MonadResource m => FindOptions -> FilePath -> CondT FileEntry m a -> ConduitT i (FileEntry, a) m () Source #

Find file entries in a directory tree, recursively, applying the given recursion predicate to the search. This conduit yields pairs of type (FileEntry, a), where is the return value from the predicate at each step.

find :: forall (m :: Type -> Type) a i. MonadResource m => FilePath -> CondT FileEntry m a -> ConduitT i FilePath m () Source #

Calls findFilePaths with the default set of finding options. Equivalent to findFilePaths defaultFindOptions.

findFilePaths :: forall (m :: Type -> Type) a i. (MonadIO m, MonadResource m) => FindOptions -> FilePath -> CondT FileEntry m a -> ConduitT i FilePath m () Source #

A simpler version of findFiles, which yields only FilePath values, and ignores any values returned by the predicate action.

test :: MonadIO m => CondT FileEntry m () -> FilePath -> m Bool Source #

Test a file path using the same type of predicate that is accepted by findFiles.

ltest :: MonadIO m => CondT FileEntry m () -> FilePath -> m Bool Source #

Test a file path using the same type of predicate that is accepted by findFiles, but do not follow symlinks.

stat :: forall (m :: Type -> Type). MonadIO m => CondT FileEntry m FileStatus Source #

lstat :: forall (m :: Type -> Type). MonadIO m => CondT FileEntry m FileStatus Source #

hasStatus :: forall (m :: Type -> Type). MonadIO m => (FileStatus -> Bool) -> CondT FileEntry m () Source #

File path predicates

glob :: forall (m :: Type -> Type). Monad m => String -> CondT FileEntry m () Source #

Find every entry whose filename part matching the given filename globbing expression. For example: glob "*.hs".

regex :: forall (m :: Type -> Type). Monad m => String -> CondT FileEntry m () Source #

ignoreVcs :: forall (m :: Type -> Type). Monad m => CondT FileEntry m () Source #

Return all entries, except for those within version-control metadata directories (and not including the version control directory itself either).

GNU find compatibility predicates

depth_ :: forall (m :: Type -> Type). Monad m => CondT FileEntry m () Source #

follow_ :: forall (m :: Type -> Type). Monad m => CondT FileEntry m () Source #

noleaf_ :: forall (m :: Type -> Type). Monad m => CondT FileEntry m () Source #

prune_ :: forall (m :: Type -> Type) a. Monad m => CondT a m () Source #

maxdepth_ :: forall (m :: Type -> Type). Monad m => Int -> CondT FileEntry m () Source #

mindepth_ :: forall (m :: Type -> Type). Monad m => Int -> CondT FileEntry m () Source #

ignoreErrors_ :: forall (m :: Type -> Type). Monad m => CondT FileEntry m () Source #

noIgnoreErrors_ :: forall (m :: Type -> Type). Monad m => CondT FileEntry m () Source #

amin_ :: forall (m :: Type -> Type). MonadIO m => Int -> CondT FileEntry m () Source #

atime_ :: forall (m :: Type -> Type). MonadIO m => Int -> CondT FileEntry m () Source #

anewer_ :: forall (m :: Type -> Type). MonadIO m => FilePath -> CondT FileEntry m () Source #

empty_ :: forall (m :: Type -> Type). MonadIO m => CondT FileEntry m () Source #

executable_ :: forall (m :: Type -> Type). MonadIO m => CondT FileEntry m () Source #

gid_ :: forall (m :: Type -> Type). MonadIO m => Int -> CondT FileEntry m () Source #

name_ :: forall (m :: Type -> Type). Monad m => FilePath -> CondT FileEntry m () Source #

getDepth :: forall (m :: Type -> Type). Monad m => CondT FileEntry m Int Source #

filename_ :: forall (m :: Type -> Type). Monad m => (FilePath -> Bool) -> CondT FileEntry m () Source #

pathname_ :: forall (m :: Type -> Type). Monad m => (FilePath -> Bool) -> CondT FileEntry m () Source #

getFilePath :: forall (m :: Type -> Type). Monad m => CondT FileEntry m FilePath Source #

File entry predicates (uses stat information)

regular :: forall (m :: Type -> Type). MonadIO m => CondT FileEntry m () Source #

directory :: forall (m :: Type -> Type). MonadIO m => CondT FileEntry m () Source #

hasMode :: forall (m :: Type -> Type). MonadIO m => FileMode -> CondT FileEntry m () Source #

executable :: forall (m :: Type -> Type). MonadIO m => CondT FileEntry m () Source #

lastAccessed_ :: forall (m :: Type -> Type). MonadIO m => (UTCTime -> Bool) -> CondT FileEntry m () Source #

lastModified_ :: forall (m :: Type -> Type). MonadIO m => (UTCTime -> Bool) -> CondT FileEntry m () Source #

Predicate combinators

apply :: Monad m => (a -> m (Maybe b)) -> CondT a m b Source #

ignore :: forall (m :: Type -> Type) a b. Monad m => CondT a m b Source #

ignore ignores the current entry, but allows recursion into its descendents. This is the same as mzero.

newtype CondT a (m :: Type -> Type) b Source #

CondT is a kind of StateT a (MaybeT m) b, which uses a special Result type instead of Maybe to express whether recursion should be performed from the item under consideration. This is used to build predicates that can guide recursive traversals.

Several different types may be promoted to CondT:

Bool
Using guard
m Bool
Using guardM
a -> Bool
Using guard_
a -> m Bool
Using guardM_
a -> m (Maybe b)
Using apply
a -> m (Maybe (b, a))
Using consider

Here is a trivial example:

flip runCondT 42 $ do
  guard_ even
  liftIO $ putStrLn "42 must be even to reach here"
  guard_ odd <|> guard_ even
  guard_ (== 42)

If CondT is executed using runCondT, it return a Maybe b if the predicate matched. It can also be run with applyCondT, which does case analysis on the Result, specifying how recursion should be performed from the given a value.

Constructors

CondT 

Fields

Instances

Instances details
MFunctor (CondT a :: (Type -> Type) -> Type -> Type) Source # 
Instance details

Defined in Data.Cond

Methods

hoist :: Monad m => (forall a0. m a0 -> n a0) -> CondT a m b -> CondT a n b #

MonadBaseControl b m => MonadBaseControl b (CondT r m) Source # 
Instance details

Defined in Data.Cond

Methods

liftBaseWith :: (RunInBase (CondT r m) b -> b a) -> CondT r m a #

restoreM :: StM (CondT r m) a -> CondT r m a #

Monad m => MonadReader a (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

ask :: CondT a m a #

local :: (a -> a) -> CondT a m a0 -> CondT a m a0 #

reader :: (a -> a0) -> CondT a m a0 #

Monad m => MonadState a (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

get :: CondT a m a #

put :: a -> CondT a m () #

state :: (a -> (a0, a)) -> CondT a m a0 #

MonadBase b m => MonadBase b (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

liftBase :: b α -> CondT a m α #

MonadTrans (CondT a) Source # 
Instance details

Defined in Data.Cond

Methods

lift :: Monad m => m a0 -> CondT a m a0 #

MonadFail m => MonadFail (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

fail :: String -> CondT a m a0 #

MonadIO m => MonadIO (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

liftIO :: IO a0 -> CondT a m a0 #

Monad m => Alternative (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

empty :: CondT a m a0 #

(<|>) :: CondT a m a0 -> CondT a m a0 -> CondT a m a0 #

some :: CondT a m a0 -> CondT a m [a0] #

many :: CondT a m a0 -> CondT a m [a0] #

Monad m => Applicative (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

pure :: a0 -> CondT a m a0 #

(<*>) :: CondT a m (a0 -> b) -> CondT a m a0 -> CondT a m b #

liftA2 :: (a0 -> b -> c) -> CondT a m a0 -> CondT a m b -> CondT a m c #

(*>) :: CondT a m a0 -> CondT a m b -> CondT a m b #

(<*) :: CondT a m a0 -> CondT a m b -> CondT a m a0 #

Monad m => Functor (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

fmap :: (a0 -> b) -> CondT a m a0 -> CondT a m b #

(<$) :: a0 -> CondT a m b -> CondT a m a0 #

Monad m => Monad (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

(>>=) :: CondT a m a0 -> (a0 -> CondT a m b) -> CondT a m b #

(>>) :: CondT a m a0 -> CondT a m b -> CondT a m b #

return :: a0 -> CondT a m a0 #

Monad m => MonadPlus (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

mzero :: CondT a m a0 #

mplus :: CondT a m a0 -> CondT a m a0 -> CondT a m a0 #

MonadCatch m => MonadCatch (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

catch :: (HasCallStack, Exception e) => CondT a m a0 -> (e -> CondT a m a0) -> CondT a m a0 #

MonadMask m => MonadMask (CondT aa m) Source # 
Instance details

Defined in Data.Cond

Methods

mask :: HasCallStack => ((forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b) -> CondT aa m b #

uninterruptibleMask :: HasCallStack => ((forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b) -> CondT aa m b #

generalBracket :: HasCallStack => CondT aa m a -> (a -> ExitCase b -> CondT aa m c) -> (a -> CondT aa m b) -> CondT aa m (b, c) #

MonadThrow m => MonadThrow (CondT a m) Source # 
Instance details

Defined in Data.Cond

Methods

throwM :: (HasCallStack, Exception e) => e -> CondT a m a0 #

(Monad m, Monoid b) => Monoid (CondT a m b) Source # 
Instance details

Defined in Data.Cond

Methods

mempty :: CondT a m b #

mappend :: CondT a m b -> CondT a m b -> CondT a m b #

mconcat :: [CondT a m b] -> CondT a m b #

(Monad m, Semigroup b) => Semigroup (CondT a m b) Source # 
Instance details

Defined in Data.Cond

Methods

(<>) :: CondT a m b -> CondT a m b -> CondT a m b #

sconcat :: NonEmpty (CondT a m b) -> CondT a m b #

stimes :: Integral b0 => b0 -> CondT a m b -> CondT a m b #

Show (CondT a m b) Source # 
Instance details

Defined in Data.Cond

Methods

showsPrec :: Int -> CondT a m b -> ShowS #

show :: CondT a m b -> String #

showList :: [CondT a m b] -> ShowS #

type StM (CondT r m) a Source # 
Instance details

Defined in Data.Cond

type StM (CondT r m) a

runCondT :: Monad m => CondT a m b -> a -> m (Maybe b) Source #

runCond :: Cond a b -> a -> Maybe b Source #

applyCondT :: Monad m => a -> CondT a m b -> m ((Maybe b, Maybe (CondT a m b)), a) Source #

Case analysis of applying a condition to an input value. The result is a pair whose first part is a pair of Maybes specifying if the input matched and if recursion is expected from this value, and whose second part is the (possibly) mutated input value.

applyCond :: a -> Cond a b -> ((Maybe b, Maybe (Cond a b)), a) Source #

Case analysis of applying a pure condition to an input value. The result is a pair whose first part is a pair of Maybes specifying if the input matched and if recursion is expected from this value, and whose second part is the (possibly) mutated input value.

guardM :: Monad m => m Bool -> CondT a m () Source #

guard_ :: forall (m :: Type -> Type) a. Monad m => (a -> Bool) -> CondT a m () Source #

guardM_ :: Monad m => (a -> m Bool) -> CondT a m () Source #

consider :: Monad m => (a -> m (Maybe (b, a))) -> CondT a m b Source #

matches :: forall (m :: Type -> Type) a b. Monad m => CondT a m b -> CondT a m Bool Source #

Return True or False depending on whether the given condition matches or not. This differs from simply stating the condition in that it itself always succeeds.

>>> flip runCond "foo.hs" $ matches (guard =<< asks (== "foo.hs"))
Just True
>>> flip runCond "foo.hs" $ matches (guard =<< asks (== "foo.hi"))
Just False

if_ :: forall (m :: Type -> Type) a r b. Monad m => CondT a m r -> CondT a m b -> CondT a m b -> CondT a m b Source #

A variant of ifM which branches on whether the condition succeeds or not. Note that if_ x is equivalent to ifM (matches x), and is provided solely for convenience.

>>> let good = guard_ (== "foo.hs") :: Cond String ()
>>> let bad  = guard_ (== "foo.hi") :: Cond String ()
>>> flip runCond "foo.hs" $ if_ good (return "Success") (return "Failure")
Just "Success"
>>> flip runCond "foo.hs" $ if_ bad (return "Success") (return "Failure")
Just "Failure"

when_ :: forall (m :: Type -> Type) a r. Monad m => CondT a m r -> CondT a m () -> CondT a m () Source #

when_ is just like when, except that it executes the body if the condition passes, rather than based on a Bool value.

>>> let good = guard_ (== "foo.hs") :: Cond String ()
>>> let bad  = guard_ (== "foo.hi") :: Cond String ()
>>> flip runCond "foo.hs" $ when_ good ignore
Nothing
>>> flip runCond "foo.hs" $ when_ bad ignore
Just ()

unless_ :: forall (m :: Type -> Type) a r. Monad m => CondT a m r -> CondT a m () -> CondT a m () Source #

when_ is just like when, except that it executes the body if the condition fails, rather than based on a Bool value.

>>> let good = guard_ (== "foo.hs") :: Cond String ()
>>> let bad  = guard_ (== "foo.hi") :: Cond String ()
>>> flip runCond "foo.hs" $ unless_ bad ignore
Nothing
>>> flip runCond "foo.hs" $ unless_ good ignore
Just ()

or_ :: forall (m :: Type -> Type) a b. Monad m => [CondT a m b] -> CondT a m b Source #

Check whether at least one of the given conditions is true. This is a synonym for asum.

>>> let good = guard_ (== "foo.hs") :: Cond String ()
>>> let bad  = guard_ (== "foo.hi") :: Cond String ()
>>> flip runCond "foo.hs" $ or_ [bad, good]
Just ()
>>> flip runCond "foo.hs" $ or_ [bad]
Nothing

and_ :: forall (m :: Type -> Type) a b. Monad m => [CondT a m b] -> CondT a m () Source #

Check that all of the given conditions are true. This is a synonym for sequence_.

>>> let good = guard_ (== "foo.hs") :: Cond String ()
>>> let bad  = guard_ (== "foo.hi") :: Cond String ()
>>> flip runCond "foo.hs" $ and_ [bad, good]
Nothing
>>> flip runCond "foo.hs" $ and_ [good]
Just ()

not_ :: forall (m :: Type -> Type) a b. Monad m => CondT a m b -> CondT a m () Source #

not_ inverts the meaning of the given predicate.

>>> let good = guard_ (== "foo.hs") :: Cond String ()
>>> let bad  = guard_ (== "foo.hi") :: Cond String ()
>>> flip runCond "foo.hs" $ not_ bad >> return "Success"
Just "Success"
>>> flip runCond "foo.hs" $ not_ good >> return "Shouldn't reach here"
Nothing

norecurse :: forall (m :: Type -> Type) a. Monad m => CondT a m () Source #

norecurse prevents recursion into the current entry's descendents, but does not ignore the entry itself.

prune :: forall (m :: Type -> Type) a b. Monad m => CondT a m b Source #

prune is a synonym for both ignoring an entry and its descendents. It is the same as ignore >> norecurse.

recurse :: forall (m :: Type -> Type) a b. Monad m => CondT a m b -> CondT a m b Source #

recurse changes the recursion predicate for any child elements. For example, the following file-finding predicate looks for all *.hs files, but under any .git directory looks only for a file named config:

if_ (name_ ".git" >> directory)
    (ignore >> recurse (name_ "config"))
    (glob "*.hs")

NOTE: If this code had used recurse (glob "*.hs")) instead in the else case, it would have meant that .git is only looked for at the top-level of the search (i.e., the top-most element).

newtype CondEitherT a (m :: Type -> Type) b Source #

This type is for documentation only, and shows the isomorphism between CondT and CondEitherT. The reason for using Result is that it makes meaning of the constructors more explicit.

Constructors

CondEitherT (StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) (b, Maybe (Maybe (CondEitherT a m b)))) 

fromCondT :: forall (m :: Type -> Type) a b. Monad m => CondT a m b -> CondEitherT a m b Source #

Witness one half of the isomorphism from CondT to CondEitherT.

toCondT :: forall (m :: Type -> Type) a b. Monad m => CondEitherT a m b -> CondT a m b Source #

Witness the other half of the isomorphism from CondEitherT to CondT.

(=~) :: (RegexMaker Regex CompOption ExecOption source, RegexContext Regex source1 target) => source1 -> source -> target #

Types and type classes

data FileEntry Source #

Constructors

FileEntry 

Fields

Instances

Instances details
Show FileEntry Source # 
Instance details

Defined in Data.Conduit.Find