find-conduit 0.1.0 → 0.2.0

raw patch · 4 files changed

+163/−91 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Conduit/Find.hs +106/−79
• Data/Conduit/Find/Looped.hs +31/−7
• find-conduit.cabal +1/−1
• test/main.hs +25/−4

@@ -5,8 +5,8 @@ module Data.Conduit.Find     ( FileEntry(..)     , Predicate-    , HasFilePath(..)-    , sourceFileEntries+    , HasFileInfo(..)+    , entryPath     , matchAll     , ignoreVcs     , regexMatcher@@ -17,6 +17,10 @@     , getPath     , regular     , executable+    , filename_+    , depth+    , withPath+    , withStatus     , prune     , test     , find@@ -30,6 +34,7 @@     , not_     ) where +import Debug.Trace import Conduit import Control.Applicative import Control.Arrow@@ -37,7 +42,6 @@ import Data.Attoparsec.Text import Data.Bits import Data.Conduit.Find.Looped-import Data.Foldable (for_) import Data.Monoid import Data.Text (Text, unpack, pack) import Filesystem.Path.CurrentOS (FilePath, encodeString, filename)@@ -45,22 +49,33 @@ import System.Posix.Files import Text.Regex.Posix ((=~)) +data FileInfo = FileInfo+    { infoPath  :: FilePath+    , infoDepth :: Int+    }++instance Show FileInfo where+    show info = "FileInfo " ++ show (infoPath info)+              ++ " " ++ show (infoDepth info)+ data FileEntry = FileEntry-    { entryPath   :: FilePath+    { entryInfo   :: FileInfo     , entryStatus :: FileStatus     }  instance Show FileEntry where-    show entry = "FileEntry " ++ show (entryPath entry)+    show entry = "FileEntry " ++ show (entryInfo entry) -class HasFilePath a where-    getFilePath :: a -> FilePath+class HasFileInfo a where+    getFileInfo :: a -> FileInfo -instance HasFilePath FilePath where-    getFilePath = id+instance HasFileInfo FileInfo where+    getFileInfo = id+    {-# INLINE getFileInfo #-} -instance HasFilePath FileEntry where-    getFilePath = entryPath+instance HasFileInfo FileEntry where+    getFileInfo = entryInfo+    {-# INLINE getFileInfo #-}  type Predicate m a = Looped m a a @@ -77,16 +92,12 @@ --   'followSymlinks' is @False@ it only prevents directory symlinks from --   being read. sourceFileEntries :: MonadResource m-                  => Looped m FilePath FileEntry-                  -> FilePath+                  => FileInfo+                  -> Looped m FileInfo FileEntry                   -> Producer m FileEntry-sourceFileEntries matcher dir = sourceDirectory dir =$= go matcher+sourceFileEntries (FileInfo p d) m = sourceDirectory p =$= awaitForever f   where-    go m = do-        mfp <- await-        for_ mfp $ \fp -> do-            applyPredicate m fp yield (`sourceFileEntries` fp)-            go m+    f fp = applyPredicate m (FileInfo (trace ("fp: " ++ show (fp)) $ fp) (trace ("d: " ++ show (d)) $ 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@@ -95,11 +106,20 @@ 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, HasFilePath e) => Predicate m e+ignoreVcs :: (MonadIO m, HasFileInfo e) => Predicate m e ignoreVcs = Looped $ \entry ->-    return $ if filename (getFilePath entry) `elem` vcsDirs+    return $ if filename (entryPath entry) `elem` vcsDirs              then Ignore              else KeepAndRecurse entry ignoreVcs   where@@ -108,7 +128,7 @@ -- | 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, HasFilePath e)+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,@@ -120,17 +140,19 @@ regexMatcher accessor (unpack -> pat) = go   where     go = Looped $ \entry ->-        return $ if encodeString (accessor (getFilePath entry)) =~ pat+        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, HasFilePath e) => Text -> Predicate m e+regex :: (Monad m, HasFileInfo e) => Text -> Predicate m e regex = regexMatcher filename  -- | Find every entry whose filename part matching the given filename globbing --   expression.  For example: @glob "*.hs"@.-glob :: (Monad m, HasFilePath e) => Text -> Predicate m e+glob :: (Monad m, HasFileInfo e) => Text -> Predicate m e glob g = case parseOnly globParser g of     Left e  -> error $ "Failed to parse glob: " ++ e     Right x -> regex ("^" <> x <> "$")@@ -151,18 +173,18 @@                             else [x]  doStat :: MonadIO m-       => (String -> IO FileStatus) -> Looped m FilePath FileEntry-doStat getstatus = Looped $ \path -> do-    s <- liftIO $ getstatus (encodeString path)-    let entry = FileEntry path s+       => (String -> IO FileStatus) -> Looped m FileInfo FileEntry+doStat getstatus = Looped $ \(FileInfo p d) -> do+    s <- liftIO $ getstatus (encodeString p)+    let entry = FileEntry (FileInfo p d) s     return $ if isDirectory s              then KeepAndRecurse entry (doStat getstatus)              else Keep entry -lstat :: MonadIO m => Looped m FilePath FileEntry+lstat :: MonadIO m => Looped m FileInfo FileEntry lstat = doStat getSymbolicLinkStatus -stat :: MonadIO m => Looped m FilePath FileEntry+stat :: MonadIO m => Looped m FileInfo FileEntry stat = doStat getFileStatus  getPath :: MonadIO m => Looped m FileEntry FilePath@@ -177,79 +199,84 @@ executable :: Monad m => Predicate m FileEntry executable = status (\s -> fileMode s .&. ownerExecuteMode /= 0) -prune :: (Monad m, HasFilePath e) => FilePath -> Predicate m e-prune path = Looped $ \entry ->-    return $ if getFilePath entry == path-             then Ignore-             else KeepAndRecurse entry (prune path)+filename_ :: (Monad m, HasFileInfo e) => FilePath -> Predicate m e+filename_ path = if_ ((== path) . filename . entryPath) +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) path alwaysTrue+    getAny `liftM` testSingle (stat >>> matcher) (FileInfo path 0) alwaysTrue   where     alwaysTrue = const (return (Any True)) -find :: (MonadIO m, MonadResource m)-     => FilePath -> Predicate m FileEntry -> Producer m FilePath-find path pr = sourceFileEntries (stat >>> pr) path =$= mapC entryPath--data FindFilter-    = IgnoreFile-    | ConsiderFile-    | MaybeRecurse+data FindFilter = IgnoreFile+                | ConsiderFile+                | MaybeRecurse     deriving (Show, Eq)  -- | Run a find, but using a pre-pass filter on the FilePaths, to eliminates --   files from consideration early and avoid calling stat on them.+doFindPreFilter :: (MonadIO m, MonadResource m)+                => FileInfo+                -> Bool+                -> Predicate m FileInfo+                -> Predicate m FileEntry+                -> Producer m FileEntry+doFindPreFilter (FileInfo path dp) follow filt pr =+    sourceDirectory path =$= awaitForever (worker (succ dp) pr)+  where+    worker d m fp = do+        let info = FileInfo fp d+        r <- lift $ runLooped filt (trace ("pf info: " ++ show (info)) $ info)+        let candidate = case r of+                Ignore -> IgnoreFile+                Keep _ -> ConsiderFile+                Recurse _ -> MaybeRecurse+                KeepAndRecurse _ _ -> ConsiderFile+        trace ("candidate: " ++ show (candidate)) $ return ()+        unless (candidate == IgnoreFile) $ do+            st <- liftIO $+                (if follow+                 then getFileStatus+                 else getSymbolicLinkStatus) (encodeString fp)+            let next = when (isDirectory st) . doFindPreFilter info follow filt+            case candidate of+                IgnoreFile   -> return ()+                MaybeRecurse -> next pr+                ConsiderFile ->+                    applyPredicate m (FileEntry (FileInfo fp d) st) yield next+ findWithPreFilter :: (MonadIO m, MonadResource m)                   => FilePath                   -> Bool-                  -> Predicate m FilePath+                  -> Predicate m FileInfo                   -> Predicate m FileEntry                   -> Producer m FileEntry-findWithPreFilter path follow filt pr =-    sourceDirectory path =$= go pr-  where-    go m = do-        mfp <- await-        for_ mfp $ \fp -> do-            r <- lift $ runLooped filt fp-            let candidate = case r of-                    Ignore -> IgnoreFile-                    Keep _ -> ConsiderFile-                    Recurse _ -> MaybeRecurse-                    KeepAndRecurse _ _ -> ConsiderFile-            unless (candidate == IgnoreFile) $ do-                st <- liftIO $-                    (if follow-                     then getFileStatus-                     else getSymbolicLinkStatus) (encodeString fp)-                let next = when (isDirectory st) .-                               findWithPreFilter fp follow filt-                case candidate of-                    IgnoreFile -> return ()-                    MaybeRecurse -> next pr-                    ConsiderFile ->-                        applyPredicate m (FileEntry fp st) yield next-            go m+findWithPreFilter path = doFindPreFilter (FileInfo path 1)  find' :: (MonadIO m, MonadResource m)       => FilePath -> Predicate m FileEntry -> Producer m FileEntry-find' path pr = sourceFileEntries (stat >>> pr) path+find' path pr = sourceFileEntries (FileInfo path 1) (stat >>> pr) -lfind :: (MonadIO m, MonadResource m)-      => FilePath -> Predicate m FileEntry -> Producer m FilePath-lfind path pr = sourceFileEntries (lstat >>> pr) path =$= mapC entryPath+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 (lstat >>> pr) path+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 =$= do-    mfp <- await-    for_ mfp $ \fp -> do+readPaths path pr = sourceDirectory path =$= awaitForever f+  where+    f fp = do         r <- lift $ runLooped pr fp         case r of             Ignore -> return ()

@@ -3,6 +3,7 @@ -- | Main entry point to the application. module Data.Conduit.Find.Looped where +import Debug.Trace import Control.Applicative import Control.Arrow import Control.Category@@ -131,7 +132,7 @@                -> (Looped m a b -> t m ()) -> t m () applyPredicate l x f g = do     r <- lift $ runLooped l x-    case r of+    case (trace ("r: " ++ show (r)) $ r) of         Ignore -> return ()         Keep a -> f a         Recurse m -> g m@@ -157,6 +158,13 @@              then KeepAndRecurse a (if_ f)              else Recurse (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)+ or_ :: MonadIO m => Looped m a b -> Looped m a b -> Looped m a b or_ (Looped f) (Looped g) = Looped $ \a -> do     r <- f a@@ -182,10 +190,26 @@     go a (Recurse l) = KeepAndRecurse a (not_ l)     go _ (KeepAndRecurse _ l) = Recurse (not_ l) -pruneIgnored :: MonadIO m => Looped m a a -> Looped m a a-pruneIgnored (Looped f) = Looped (\a -> go a `liftM` f a)+prune :: MonadIO m => Looped m a a -> Looped m a a+prune (Looped f) = Looped (\a -> go a `liftM` f a)   where-    go _ Ignore = Ignore-    go _ x@(Keep _) = x-    go _ (Recurse _) = Ignore-    go _ (KeepAndRecurse b m) = KeepAndRecurse b (pruneIgnored m)+    go a Ignore = trace ("prune keep") $ Keep a+    go _ (Keep _) = trace ("prune drop") $ Ignore+    go a (Recurse l) = trace ("prune keepr") $ KeepAndRecurse a (prune l)+    go _ (KeepAndRecurse _ _) = trace ("prune drop") $ Ignore++promote :: Monad m => (a -> m (Maybe b)) -> Looped m a b+promote f = Looped $ \a -> do+    r <- f a+    return $ case r of+        Nothing -> Recurse (promote f)+        Just b -> KeepAndRecurse b (promote f)++demote :: Monad m => Looped m a b -> a -> m (Maybe b)+demote (Looped f) a = do+    r <- f a+    return $ case r of+        Ignore -> Nothing+        Keep b -> Just b+        Recurse _ -> Nothing+        KeepAndRecurse b _ -> Just b

@@ -1,5 +1,5 @@ Name:                find-conduit-Version:             0.1.0+Version:             0.2.0 Synopsis:            A file-finding conduit that allows user control over traversals. License-file:        LICENSE License:             MIT

@@ -26,7 +26,7 @@             xs <- runResourceT $                 find "."                     (    ignoreVcs-                     >>> prune "./dist"+                     >>> prune (filename_ "dist")                      >>> glob "*.hs"                      >>> not_ (glob "Setup*")                      >>> regular@@ -45,7 +45,9 @@                     (    ignoreVcs                      >>> glob "*.hs"                      >>> not_ (glob "Setup*")-                     >>> prune "./dist"+                     -- This prune only applies to .hs files now, so it won't+                     -- match anything, thus having no effect but burning CPU!+                     >>> prune (filename_ "dist")                      >>> regular                      >>> not_ executable                     )@@ -60,16 +62,35 @@             xs <- runResourceT $                 findWithPreFilter "." True                     (    ignoreVcs+                     >>> prune (filename_ "dist")                      >>> glob "*.hs"                      >>> not_ (glob "Setup*")-                     >>> prune "./dist"                     )                     (    regular                      >>> not_ executable                     )-                    =$ mapC getFilePath $$ sinkList+                    =$ mapC entryPath $$ sinkList              "./Data/Conduit/Find.hs" `elem` xs `shouldBe` True+            "./dist/setup-config" `elem` xs `shouldBe` False+            "./Setup.hs" `elem` xs `shouldBe` False+            "./.git/config" `elem` xs `shouldBe` False++        it "properly applies post-pass pruning" $ do+            xs <- runResourceT $+                findWithPreFilter "." True+                    (    ignoreVcs+                     >>> prune (depth (>=1))+                     >>> prune (filename_ "dist")+                     >>> glob "*.hs"+                     >>> not_ (glob "Setup*")+                    )+                    (    regular+                     >>> not_ executable+                    )+                    =$ mapC entryPath $$ sinkList++            "./Data/Conduit/Find.hs" `elem` xs `shouldBe` False             "./dist/setup-config" `elem` xs `shouldBe` False             "./Setup.hs" `elem` xs `shouldBe` False             "./.git/config" `elem` xs `shouldBe` False