packages feed

find-conduit 0.2.1 → 0.2.2

raw patch · 4 files changed

+233/−167 lines, 4 filesdep +semigroupsdep +timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: semigroups, time

API changes (from Hackage documentation)

- Data.Conduit.Find: getPath :: MonadIO m => Looped m FileEntry FilePath
- Data.Conduit.Find: regexMatcher :: (Monad m, HasFileInfo e) => (FilePath -> FilePath) -> Text -> Predicate m e
+ Data.Conduit.Find: consider :: a -> Looped m a b -> Looped m a b
+ Data.Conduit.Find: filenameS_ :: (Monad m, HasFileInfo e) => (String -> Bool) -> Predicate m e
+ Data.Conduit.Find: filepathS_ :: (Monad m, HasFileInfo e) => (String -> Bool) -> Predicate m e
+ Data.Conduit.Find: filepath_ :: (Monad m, HasFileInfo e) => (FilePath -> Bool) -> Predicate m e
+ Data.Conduit.Find: hasMode :: Monad m => FileMode -> Predicate m FileEntry
+ Data.Conduit.Find: ignoreAll :: Monad m => Looped m a b
+ Data.Conduit.Find: lastAccessed :: Monad m => (UTCTime -> Bool) -> Predicate m FileEntry
+ Data.Conduit.Find: lastModified :: Monad m => (UTCTime -> Bool) -> Predicate m FileEntry
- Data.Conduit.Find: filename_ :: (Monad m, HasFileInfo e) => FilePath -> Predicate m e
+ Data.Conduit.Find: filename_ :: (Monad m, HasFileInfo e) => (FilePath -> Bool) -> Predicate m e
- Data.Conduit.Find: not_ :: MonadIO m => Looped m a a -> Looped m a a
+ Data.Conduit.Find: not_ :: MonadIO m => Predicate m a -> Predicate m a
- Data.Conduit.Find: prune :: MonadIO m => Looped m a a -> Looped m a a
+ Data.Conduit.Find: prune :: MonadIO m => Predicate m a -> Predicate m a

Files

Data/Conduit/Find.hs view
@@ -6,19 +6,25 @@     ( FileEntry(..)     , Predicate     , HasFileInfo(..)+    , consider     , entryPath     , matchAll+    , ignoreAll     , ignoreVcs-    , regexMatcher     , regex     , glob     , stat     , lstat-    , getPath     , regular+    , hasMode     , executable     , filename_+    , filenameS_+    , filepath_+    , filepathS_     , depth+    , lastAccessed+    , lastModified     , withPath     , withStatus     , prune@@ -43,9 +49,12 @@ import Data.Conduit.Find.Looped import Data.Monoid import Data.Text (Text, unpack, pack)+import Data.Time+import Data.Time.Clock.POSIX import Filesystem.Path.CurrentOS (FilePath, encodeString, filename) import Prelude hiding (FilePath) import System.Posix.Files+import System.Posix.Types import Text.Regex.Posix ((=~))  data FileInfo = FileInfo@@ -76,45 +85,9 @@     getFileInfo = entryInfo     {-# INLINE getFileInfo #-} -type Predicate m a = Looped m a a---- | Walk through the entries of a directory tree, allowing the user to---   specify a 'Predicate' which may decides not only which entries to yield---   from the conduit, but also which directories to follow, and how to---   recurse into that directory by permitting the use of a subsequent---   'Predicate'.------   Note that the 'followSymlinks' parameter to this function has a different---   meaning than it does for 'sourceDirectoryDeep': if @True@, symlinks are---   never passed to the predicate, only what they point to; if @False@,---   symlinks are never read at all.  For 'sourceDirectoryDeep', if---   'followSymlinks' is @False@ it only prevents directory symlinks from---   being read.-sourceFileEntries :: MonadResource m-                  => FileInfo-                  -> Looped m FileInfo FileEntry-                  -> Producer m FileEntry-sourceFileEntries (FileInfo p d) m = sourceDirectory p =$= awaitForever f-  where-    f fp = applyPredicate m (FileInfo fp d) yield $-        sourceFileEntries (FileInfo fp (succ d))---- | Return all entries.  This is the same as 'sourceDirectoryDeep', except---   that the 'FileStatus' structure for each entry is also provided.  As a---   result, only one stat call is ever made per entry, compared to two per---   directory in the current version of 'sourceDirectoryDeep'.-matchAll :: Monad m => Predicate m a-matchAll = Looped $ \entry -> return $ KeepAndRecurse entry matchAll- entryPath :: HasFileInfo a => a -> FilePath entryPath = infoPath . getFileInfo -withPath :: HasFileInfo a => Monad m => (FilePath -> m Bool) -> Predicate m a-withPath f = ifM_ (f . entryPath)--withStatus :: Monad m => (FileStatus -> m Bool) -> Predicate m FileEntry-withStatus f = ifM_ (f . entryStatus)- -- | Return all entries, except for those within version-control metadata --   directories (and not including the version control directory itself either). ignoreVcs :: (MonadIO m, HasFileInfo e) => Predicate m e@@ -125,30 +98,9 @@   where     vcsDirs = [ ".git", "CVS", "RCS", "SCCS", ".svn", ".hg", "_darcs" ] --- | The 'regexMatcher' predicate builder matches some part of every path---   against a given regex.  Use the simpler 'regex' if you just want to apply---   a regex to every file name.-regexMatcher :: (Monad m, HasFileInfo e)-             => (FilePath -> FilePath)-                -- ^ Function that specifies which part of the pathname to-                --   match against.  Use this to match against only filenames,-                --   or to relativize the path against the search root before-                --   comparing.-             -> Text-                -- ^ The regular expression search pattern.-             -> Predicate m e-regexMatcher accessor (unpack -> pat) = go-  where-    go = Looped $ \entry ->-        return $ if pathStr entry =~ pat-                 then KeepAndRecurse entry go-                 else Recurse go--    pathStr = encodeString . accessor . entryPath- -- | Find every entry whose filename part matching the given regular expression. regex :: (Monad m, HasFileInfo e) => Text -> Predicate m e-regex = regexMatcher filename+regex pat = filenameS_ (=~ unpack pat)  -- | Find every entry whose filename part matching the given filename globbing --   expression.  For example: @glob "*.hs"@.@@ -187,30 +139,98 @@ stat :: MonadIO m => Looped m FileInfo FileEntry stat = doStat getFileStatus -getPath :: MonadIO m => Looped m FileEntry FilePath-getPath = liftLooped (return . entryPath)+withStatus :: Monad m => (FileStatus -> m Bool) -> Predicate m FileEntry+withStatus f = ifM_ (f . entryStatus)  status :: Monad m => (FileStatus -> Bool) -> Predicate m FileEntry-status f = if_ (f . entryStatus)+status f = withStatus (return . f)  regular :: Monad m => Predicate m FileEntry regular = status isRegularFile +hasMode :: Monad m => FileMode -> Predicate m FileEntry+hasMode m = status (\s -> fileMode s .&. m /= 0)+ executable :: Monad m => Predicate m FileEntry-executable = status (\s -> fileMode s .&. ownerExecuteMode /= 0)+executable = hasMode ownerExecuteMode -filename_ :: (Monad m, HasFileInfo e) => FilePath -> Predicate m e-filename_ path = if_ ((== path) . filename . entryPath)+withPath :: HasFileInfo a => Monad m => (FilePath -> m Bool) -> Predicate m a+withPath f = ifM_ (f . entryPath) +filename_ :: (Monad m, HasFileInfo e) => (FilePath -> Bool) -> Predicate m e+filename_ f = withPath (return . f . filename)++filenameS_ :: (Monad m, HasFileInfo e) => (String -> Bool) -> Predicate m e+filenameS_ f = withPath (return . f . encodeString . filename)++filepath_ :: (Monad m, HasFileInfo e) => (FilePath -> Bool) -> Predicate m e+filepath_ f = withPath (return . f)++filepathS_ :: (Monad m, HasFileInfo e) => (String -> Bool) -> Predicate m e+filepathS_ f = withPath (return . f . encodeString)+ depth :: (Monad m, HasFileInfo e) => (Int -> Bool) -> Predicate m e depth f = if_ (f . infoDepth . getFileInfo) -test :: MonadIO m => Predicate m FileEntry -> FilePath -> m Bool-test matcher path =-    getAny `liftM` testSingle (stat >>> matcher) (FileInfo path 0) alwaysTrue+withStatusTime :: Monad m+               => (UTCTime -> Bool) -> (FileStatus -> POSIXTime)+               -> Predicate m FileEntry+withStatusTime f g = status (f . posixSecondsToUTCTime . g)++lastAccessed :: Monad m => (UTCTime -> Bool) -> Predicate m FileEntry+lastAccessed = flip withStatusTime accessTimeHiRes++lastModified :: Monad m => (UTCTime -> Bool) -> Predicate m FileEntry+lastModified = flip withStatusTime modificationTimeHiRes++-- Walk through the entries of a directory tree, allowing the user to specify+-- a 'Predicate' which may decides not only which entries to yield from the+-- conduit, but also which directories to follow, and how to recurse into that+-- directory by permitting the use of a subsequent 'Predicate'.+--+-- Note that the 'followSymlinks' parameter to this function has a different+-- meaning than it does for 'sourceDirectoryDeep': if @True@, symlinks are+-- never passed to the predicate, only what they point to; if @False@,+-- symlinks are never read at all.  For 'sourceDirectoryDeep', if+-- 'followSymlinks' is @False@ it only prevents directory symlinks from being+-- read.+sourceFileEntries :: MonadResource m+                  => FileInfo+                  -> Looped m FileInfo FileEntry+                  -> Producer m FileEntry+sourceFileEntries (FileInfo p d) m = sourceDirectory p =$= awaitForever f   where-    alwaysTrue = const (return (Any True))+    f fp = applyLooped m (FileInfo fp d) yield $+        sourceFileEntries (FileInfo fp (succ d)) +find' :: (MonadIO m, MonadResource m)+      => FilePath -> Predicate m FileEntry -> Producer m FileEntry+find' path pr = sourceFileEntries (FileInfo path 1) (stat >>> pr)++find :: (MonadIO m, MonadResource m)+     => FilePath -> Predicate m FileEntry -> Producer m FilePath+find path pr = find' path pr =$= mapC entryPath++lfind' :: (MonadIO m, MonadResource m)+       => FilePath -> Predicate m FileEntry -> Producer m FileEntry+lfind' path pr = sourceFileEntries (FileInfo path 1) (lstat >>> pr)++lfind :: (MonadIO m, MonadResource m)+      => FilePath -> Predicate m FileEntry -> Producer m FilePath+lfind path pr = lfind' path pr =$= mapC entryPath++readPaths :: (MonadIO m, MonadResource m)+          => FilePath -> Predicate m FilePath -> Producer m FilePath+readPaths path pr = sourceDirectory path =$= awaitForever f+  where+    f fp = do+        r <- lift $ runLooped pr fp+        case r of+            Ignore -> return ()+            Keep a -> yield a+            RecurseOnly _ -> return ()+            KeepAndRecurse a _ -> yield a+ data FindFilter = IgnoreFile                 | ConsiderFile                 | MaybeRecurse@@ -233,7 +253,7 @@         let candidate = case r of                 Ignore -> IgnoreFile                 Keep _ -> ConsiderFile-                Recurse _ -> MaybeRecurse+                RecurseOnly _ -> MaybeRecurse                 KeepAndRecurse _ _ -> ConsiderFile         unless (candidate == IgnoreFile) $ do             st <- liftIO $@@ -245,7 +265,7 @@                 IgnoreFile   -> return ()                 MaybeRecurse -> next pr                 ConsiderFile ->-                    applyPredicate m (FileEntry (FileInfo fp d) st) yield next+                    applyLooped m (FileEntry (FileInfo fp d) st) yield next  findWithPreFilter :: (MonadIO m, MonadResource m)                   => FilePath@@ -255,30 +275,10 @@                   -> Producer m FileEntry findWithPreFilter path = doFindPreFilter (FileInfo path 1) -find' :: (MonadIO m, MonadResource m)-      => FilePath -> Predicate m FileEntry -> Producer m FileEntry-find' path pr = sourceFileEntries (FileInfo path 1) (stat >>> pr)--find :: (MonadIO m, MonadResource m)-     => FilePath -> Predicate m FileEntry -> Producer m FilePath-find path pr = find' path pr =$= mapC entryPath--lfind' :: (MonadIO m, MonadResource m)-       => FilePath -> Predicate m FileEntry -> Producer m FileEntry-lfind' path pr = sourceFileEntries (FileInfo path 1) (lstat >>> pr)--lfind :: (MonadIO m, MonadResource m)-      => FilePath -> Predicate m FileEntry -> Producer m FilePath-lfind path pr = lfind' path pr =$= mapC entryPath--readPaths :: (MonadIO m, MonadResource m)-          => FilePath -> Predicate m FilePath -> Producer m FilePath-readPaths path pr = sourceDirectory path =$= awaitForever f+-- | Test a file path using the same type of 'Predicate' that is accepted by+--   'find'.+test :: MonadIO m => Predicate m FileEntry -> FilePath -> m Bool+test matcher path =+    getAny `liftM` testSingle (stat >>> matcher) (FileInfo path 0) alwaysTrue   where-    f fp = do-        r <- lift $ runLooped pr fp-        case r of-            Ignore -> return ()-            Keep a -> yield a-            Recurse _ -> return ()-            KeepAndRecurse a _ -> yield a+    alwaysTrue = const (return (Any True))
Data/Conduit/Find/Looped.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}  -- | Main entry point to the application. module Data.Conduit.Find.Looped where@@ -8,32 +10,33 @@ import Control.Category import Control.Monad import Control.Monad.Trans-import Data.Monoid+import Data.Monoid hiding ((<>)) import Data.Profunctor+import Data.Semigroup import Prelude hiding ((.), id)  data Result m a b     = Ignore     | Keep b-    | Recurse (Looped m a b)+    | RecurseOnly (Looped m a b)     | KeepAndRecurse b (Looped m a b)  instance Show a => Show (Result r m a) where     show Ignore = "Ignore"     show (Keep a) = "Keep " ++ show a-    show (Recurse _) = "Recurse"+    show (RecurseOnly _) = "RecurseOnly"     show (KeepAndRecurse a _) = "KeepAndRecurse " ++ show a  instance Functor m => Functor (Result m a) where     fmap _ Ignore = Ignore     fmap f (Keep a) = Keep (f a)-    fmap f (Recurse l) = Recurse (fmap f l)+    fmap f (RecurseOnly l) = RecurseOnly (fmap f l)     fmap f (KeepAndRecurse a l)  = KeepAndRecurse (f a) (fmap f l)  instance Functor m => Profunctor (Result m) where     lmap _ Ignore = Ignore     lmap _ (Keep a) = Keep a-    lmap f (Recurse l) = Recurse (lmap f l)+    lmap f (RecurseOnly l) = RecurseOnly (lmap f l)     lmap f (KeepAndRecurse a l)  = KeepAndRecurse a (lmap f l)     rmap = fmap @@ -47,12 +50,35 @@     Keep a >>= f = case f a of         Ignore -> Ignore         Keep b -> Keep b-        (Recurse _) -> Ignore+        (RecurseOnly _) -> Ignore         (KeepAndRecurse b _) -> Keep b-    Recurse (Looped l) >>= f =-        Recurse (Looped $ \r -> liftM (>>= f) (l r))+    RecurseOnly (Looped l) >>= f =+        RecurseOnly (Looped $ \r -> liftM (>>= f) (l r))     KeepAndRecurse a _ >>= f = f a +instance Semigroup (Result m a a) where+    Ignore <> _ = Ignore+    _ <> Ignore = Ignore+    RecurseOnly m <> _ = RecurseOnly m+    _ <> RecurseOnly m = RecurseOnly m+    _ <> Keep b = Keep b+    Keep _ <> KeepAndRecurse b _ = Keep b+    KeepAndRecurse _ _ <> KeepAndRecurse b m = KeepAndRecurse b m++instance Monoid (Result m a a) where+    mempty = Ignore+    x `mappend` y = x <> y++instance Monad m => MonadPlus (Result m a) where+    mzero = Ignore+    Ignore `mplus` _ = Ignore+    _ `mplus` Ignore = Ignore+    RecurseOnly m `mplus` _ = RecurseOnly m+    _ `mplus` RecurseOnly m = RecurseOnly m+    _ `mplus` Keep b = Keep b+    Keep _ `mplus` KeepAndRecurse b _ = Keep b+    KeepAndRecurse _ _ `mplus` KeepAndRecurse b m = KeepAndRecurse b m+ newtype Looped m a b = Looped { runLooped :: a -> m (Result m a b) }  instance Functor m => Functor (Looped m a) where@@ -73,7 +99,7 @@         case r of             Ignore -> return Ignore             Keep b -> runLooped (k b) a-            Recurse l -> runLooped (l >>= k) a+            RecurseOnly l -> runLooped (l >>= k) a             KeepAndRecurse b _ -> runLooped (k b) a  instance Monad m => Category (Looped m) where@@ -87,17 +113,17 @@                 return $ case r' of                     Ignore -> Ignore                     Keep c -> Keep c-                    Recurse _ -> Ignore+                    RecurseOnly _ -> Ignore                     KeepAndRecurse c _ -> Keep c-            Recurse (Looped l) ->-                return $ Recurse (Looped f . Looped l)+            RecurseOnly (Looped l) ->+                return $ RecurseOnly (Looped f . Looped l)             KeepAndRecurse b (Looped l) -> do                 r' <- f b                 return $ case r' of                     Ignore -> Ignore                     Keep c -> Keep c-                    Recurse (Looped m) ->-                        Recurse (Looped m . Looped l)+                    RecurseOnly (Looped m) ->+                        RecurseOnly (Looped m . Looped l)                     KeepAndRecurse c (Looped m) ->                         KeepAndRecurse c (Looped m . Looped l) @@ -108,33 +134,33 @@         return $ case r of             Ignore -> Ignore             Keep b -> Keep (b, c)-            Recurse l -> Recurse (first l)+            RecurseOnly l -> RecurseOnly (first l)             KeepAndRecurse b l -> KeepAndRecurse (b, c) (first l) -evens :: Monad m => Looped m Int Int-evens = Looped $ \x ->-    return $ if even x-             then KeepAndRecurse x evens-             else Recurse evens--tens :: Monad m => Looped m Int Int-tens = Looped $ \x ->-    return $ if x `mod` 10 == 0-             then KeepAndRecurse x tens-             else Ignore--apply :: Looped m a b -> a -> Looped m a b-apply l x = Looped $ const $ runLooped l x+-- | Within a predicate block, 'consider' a different item than what is+--   currently being predicated upon.  This makes it possible to write custom+--   logic within the Monad instance for Looped, such as in this contrived+--   example:+--+-- @+--   flip runLooped "bar.hs" $ do+--       x <- filename_ (== "foo.hs")+--       when (x /= "") $+--           consider "baz.hs" $+--               filename_ (== "baz.hs")    -- passes+-- @+consider :: a -> Looped m a b -> Looped m a b+consider x l = Looped $ const $ runLooped l x -applyPredicate :: (MonadTrans t, (Monad (t m)), Monad m, Show b)-               => Looped m a b -> a -> (b -> t m ())-               -> (Looped m a b -> t m ()) -> t m ()-applyPredicate l x f g = do+applyLooped :: (MonadTrans t, (Monad (t m)), Monad m, Show b)+            => Looped m a b -> a -> (b -> t m ())+            -> (Looped m a b -> t m ()) -> t m ()+applyLooped l x f g = do     r <- lift $ runLooped l x     case r of         Ignore -> return ()         Keep a -> f a-        Recurse m -> g m+        RecurseOnly m -> g m         KeepAndRecurse a m -> f a >> g m  testSingle :: (Monad m, Monoid c) => Looped m a b -> a -> (b -> m c) -> m c@@ -143,26 +169,21 @@     case r of         Ignore -> return mempty         Keep a -> f a-        Recurse _ -> return mempty+        RecurseOnly _ -> return mempty         KeepAndRecurse a _ -> f a -liftLooped :: Monad m => (a -> m b) -> Looped m a b-liftLooped f = Looped $ \a -> do-    r <- f a-    return $ KeepAndRecurse r (liftLooped f)- if_ :: Monad m => (a -> Bool) -> Looped m a a if_ f = Looped $ \a ->     return $ if f a              then KeepAndRecurse a (if_ f)-             else Recurse (if_ f)+             else RecurseOnly (if_ f)  ifM_ :: Monad m => (a -> m Bool) -> Looped m a a ifM_ f = Looped $ \a -> do     r <- f a     return $ if r              then KeepAndRecurse a (ifM_ f)-             else Recurse (ifM_ f)+             else RecurseOnly (ifM_ f)  or_ :: MonadIO m => Looped m a b -> Looped m a b -> Looped m a b or_ (Looped f) (Looped g) = Looped $ \a -> do@@ -178,37 +199,78 @@     case r of         Ignore -> return Ignore         Keep _ -> g a-        Recurse l -> return $ Recurse l+        RecurseOnly l -> return $ RecurseOnly l         KeepAndRecurse _ _ -> g a -not_ :: MonadIO m => Looped m a a -> Looped m a a-not_ (Looped f) = Looped (\a -> go a `liftM` f a)-  where-    go a Ignore = Keep a-    go _ (Keep _) = Ignore-    go a (Recurse l) = KeepAndRecurse a (not_ l)-    go _ (KeepAndRecurse _ l) = Recurse (not_ l)+liftArrow :: Monad m => (a -> b) -> Looped m a b+liftArrow f = Looped $ \a -> return $ KeepAndRecurse (f a) (liftArrow f) -prune :: MonadIO m => Looped m a a -> Looped m a a-prune (Looped f) = Looped (\a -> go a `liftM` f a)-  where-    go a Ignore = Keep a-    go _ (Keep _) = Ignore-    go a (Recurse l) = KeepAndRecurse a (prune l)-    go _ (KeepAndRecurse _ _) = Ignore+liftKleisli :: Monad m => (a -> m b) -> Looped m a b+liftKleisli f = Looped $ \a -> do+    r <- f a+    return $ KeepAndRecurse r (liftKleisli f) -promote :: Monad m => (a -> m (Maybe b)) -> Looped m a b-promote f = Looped $ \a -> do+liftKleisliMaybe :: Monad m => (a -> m (Maybe b)) -> Looped m a b+liftKleisliMaybe f = Looped $ \a -> do     r <- f a     return $ case r of-        Nothing -> Recurse (promote f)-        Just b -> KeepAndRecurse b (promote f)+        Nothing -> RecurseOnly (liftKleisliMaybe f)+        Just b -> KeepAndRecurse b (liftKleisliMaybe f) -demote :: Monad m => Looped m a b -> a -> m (Maybe b)-demote (Looped f) a = do+lowerKleisliMaybe :: Monad m => Looped m a b -> a -> m (Maybe b)+lowerKleisliMaybe (Looped f) a = do     r <- f a     return $ case r of         Ignore -> Nothing         Keep b -> Just b-        Recurse _ -> Nothing+        RecurseOnly _ -> Nothing         KeepAndRecurse b _ -> Just b++type Predicate m a = Looped m a a++instance (Functor m, Monad m) => Semigroup (Predicate m a) where+    Looped f <> Looped g = Looped $ \a -> do+        r <- f a+        case r of+            Ignore -> g a+            Keep b -> return $ Keep b+            RecurseOnly _ -> g a+            KeepAndRecurse b m -> return $ KeepAndRecurse b m++instance (Functor m, Monad m) => Monoid (Predicate m a) where+    mempty = let x = Looped (\a -> return $ KeepAndRecurse a x) in x+    f `mappend` g = f <> g++instance Monad m => MonadPlus (Looped m a) where+    mzero = Looped $ const $ return Ignore+    Looped f `mplus` Looped g = Looped $ \a -> do+        r <- f a+        case r of+            Ignore -> g a+            Keep b -> return $ Keep b+            RecurseOnly _ -> g a+            KeepAndRecurse b m -> return $ KeepAndRecurse b m++matchAll :: Monad m => Predicate m a+matchAll = Looped $ \entry -> return $ KeepAndRecurse entry matchAll++ignoreAll :: Monad m => Looped m a b+ignoreAll = Looped $ const $ return $ RecurseOnly ignoreAll++-- | 'not_' reverse the meaning of the given predicate, preserving recursion.+not_ :: MonadIO m => Predicate m a -> Predicate m a+not_ (Looped f) = Looped (\a -> go a `liftM` f a)+  where+    go a Ignore = Keep a+    go _ (Keep _) = Ignore+    go a (RecurseOnly l) = KeepAndRecurse a (not_ l)+    go _ (KeepAndRecurse _ l) = RecurseOnly (not_ l)++-- | 'prune' is much like 'not_', but does not preserve recursion.+prune :: MonadIO m => Predicate m a -> Predicate m a+prune (Looped f) = Looped (\a -> go a `liftM` f a)+  where+    go a Ignore = Keep a+    go _ (Keep _) = Ignore+    go a (RecurseOnly l) = KeepAndRecurse a (prune l)+    go _ (KeepAndRecurse _ _) = Ignore
find-conduit.cabal view
@@ -1,5 +1,5 @@ Name:                find-conduit-Version:             0.2.1+Version:             0.2.2 Synopsis:            A file-finding conduit that allows user control over traversals. License-file:        LICENSE License:             MIT@@ -29,6 +29,8 @@       , regex-posix       , profunctors       , mtl+      , semigroups+      , time     exposed-modules:         Data.Conduit.Find     other-modules:@@ -51,4 +53,6 @@       , text                 >= 0.11.3.1       , regex-posix       , mtl+      , time+      , semigroups       , hspec                >= 1.4
test/main.hs view
@@ -26,7 +26,7 @@             xs <- runResourceT $                 find "."                     (    ignoreVcs-                     >>> prune (filename_ "dist")+                     >>> prune (filename_ (== "dist"))                      >>> glob "*.hs"                      >>> not_ (glob "Setup*")                      >>> regular@@ -47,7 +47,7 @@                      >>> not_ (glob "Setup*")                      -- This prune only applies to .hs files now, so it won't                      -- match anything, thus having no effect but burning CPU!-                     >>> prune (filename_ "dist")+                     >>> prune (filename_ (== "dist"))                      >>> regular                      >>> not_ executable                     )@@ -62,7 +62,7 @@             xs <- runResourceT $                 findWithPreFilter "." True                     (    ignoreVcs-                     >>> prune (filename_ "dist")+                     >>> prune (filename_ (== "dist"))                      >>> glob "*.hs"                      >>> not_ (glob "Setup*")                     )@@ -81,7 +81,7 @@                 findWithPreFilter "." True                     (    ignoreVcs                      >>> prune (depth (>=1))-                     >>> prune (filename_ "dist")+                     >>> prune (filename_ (== "dist"))                      >>> glob "*.hs"                      >>> not_ (glob "Setup*")                     )