add flag to follow symlinks when recursing

System/FilePath/Find.hs

@@ -45,11 +45,15 @@ module System.FilePath.Find (
 
     -- * Simple entry points
     , find
+    , findL
     , fold
+    , foldL
 
     -- * More expressive entry points
     , findWithHandler
+    , findWithHandlerL
     , foldWithHandler
+    , foldWithHandlerL
 
     -- * Helper functions
     , evalClause
@@ -215,15 +219,16 @@ getDirContents dir = (sort . filter goodName) `liftM` getDirectoryContents dir
 -- 'RecursionPredicate'.  Lazily return a sorted list of all files
 -- matching the given 'FilterPredicate'.  Any errors that occur are
 -- dealt with by the given handler.
-findWithHandler ::
-    (FilePath -> IOException -> IO [FilePath]) -- ^ error handler
+findWithHandlerL ::
+    Bool -- ^ follow symlinks
+    -> (FilePath -> IOException -> IO [FilePath]) -- ^ error handler
     -> RecursionPredicate -- ^ control recursion into subdirectories
     -> FilterPredicate -- ^ decide whether a file appears in the result
     -> FilePath -- ^ directory to start searching
     -> IO [FilePath] -- ^ files that matched the 'FilterPredicate'
 
-findWithHandler errHandler recurse filt path0 =
-    handle (errHandler path0) $ F.getSymbolicLinkStatus path0 >>= visit path0 0
+findWithHandlerL links errHandler recurse filt path0 =
+    handle (errHandler path0) $ getStatus links path0 >>= visit path0 0
   where visit path depth st =
             if F.isDirectory st && evalFI recurse path depth st
               then unsafeInterleaveIO (traverse path (succ depth) st)
@@ -240,19 +245,39 @@ findWithHandler errHandler recurse filt path0 =
                 then path:result
                 else result
 
+getStatus :: Bool -> FilePath -> IO F.FileStatus
+getStatus links = if links then F.getFileStatus else F.getSymbolicLinkStatus
+
+-- | Same as 'findWithHandlerL' without following links
+findWithHandler ::
+    (FilePath -> IOException -> IO [FilePath]) -- ^ error handler
+    -> RecursionPredicate -- ^ control recursion into subdirectories
+    -> FilterPredicate -- ^ decide whether a file appears in the result
+    -> FilePath -- ^ directory to start searching
+    -> IO [FilePath] -- ^ files that matched the 'FilterPredicate'
+findWithHandler = findWithHandlerL False
+
 -- | Search a directory recursively, with recursion controlled by a
 -- 'RecursionPredicate'.  Lazily return a sorted list of all files
 -- matching the given 'FilterPredicate'.  Any errors that occur are
 -- ignored, with warnings printed to 'stderr'.
-find :: RecursionPredicate -- ^ control recursion into subdirectories
+findL :: Bool -- ^ follow symlinks
+      -> RecursionPredicate -- ^ control recursion into subdirectories
       -> FilterPredicate -- ^ decide whether a file appears in the result
       -> FilePath -- ^ directory to start searching
       -> IO [FilePath] -- ^ files that matched the 'FilterPredicate'
 
-find = findWithHandler warnOnError
+findL links = findWithHandlerL links warnOnError
     where warnOnError path err =
               hPutStrLn stderr (path ++ ": " ++ show err) >> return []
 
+-- | Same as 'findL' without following links
+find :: RecursionPredicate -- ^ control recursion into subdirectories
+     -> FilterPredicate -- ^ decide whether a file appears in the result
+     -> FilePath -- ^ directory to start searching
+     -> IO [FilePath] -- ^ files that matched the 'FilterPredicate'
+find = findL False
+
 -- | Search a directory recursively, with recursion controlled by a
 -- 'RecursionPredicate'.  Fold over all files found.  Any errors that
 -- occur are dealt with by the given handler.  The fold is strict, and
@@ -260,17 +285,17 @@ find = findWithHandler warnOnError
 -- strict in its left argument to avoid space leaks.  If you need a
 -- right-to-left fold, use 'foldr' on the result of 'findWithHandler'
 -- instead.
-foldWithHandler
-    :: (FilePath -> a -> IOException -> IO a) -- ^ error handler
+foldWithHandlerL
+    :: Bool -- ^ follow symlinks
+    -> (FilePath -> a -> IOException -> IO a) -- ^ error handler
     -> RecursionPredicate -- ^ control recursion into subdirectories
     -> (a -> FileInfo -> a) -- ^ function to fold with
     -> a -- ^ seed value for fold
     -> FilePath -- ^ directory to start searching
     -> IO a -- ^ final value after folding
 
-foldWithHandler errHandler recurse f state path =
-    handle (errHandler path state) $
-        F.getSymbolicLinkStatus path >>= visit state path 0
+foldWithHandlerL links errHandler recurse f state path =
+    handle (errHandler path state) $ getStatus links path >>= visit state path 0
   where visit state path depth st =
             if F.isDirectory st && evalFI recurse path depth st
             then traverse state path (succ depth) st
@@ -284,6 +309,16 @@ foldWithHandler errHandler recurse f state path =
                     let path = dir </> name
                     in F.getSymbolicLinkStatus path >>= visit state path depth)
 
+-- | Same as 'foldWithHandlerL' without following symlinks
+foldWithHandler
+    :: (FilePath -> a -> IOException -> IO a) -- ^ error handler
+    -> RecursionPredicate -- ^ control recursion into subdirectories
+    -> (a -> FileInfo -> a) -- ^ function to fold with
+    -> a -- ^ seed value for fold
+    -> FilePath -- ^ directory to start searching
+    -> IO a -- ^ final value after folding
+foldWithHandler = foldWithHandlerL False
+
 -- | Search a directory recursively, with recursion controlled by a
 -- 'RecursionPredicate'.  Fold over all files found.  Any errors that
 -- occur are ignored, with warnings printed to 'stderr'.  The fold
@@ -291,16 +326,25 @@ foldWithHandler errHandler recurse f state path =
 -- in its left argument to avoid space leaks.  If you need a
 -- right-to-left fold, use 'foldr' on the result of 'findWithHandler'
 -- instead.
-fold :: RecursionPredicate
+foldL :: Bool -- ^ follow symlinks
+      -> RecursionPredicate
       -> (a -> FileInfo -> a)
       -> a
       -> FilePath
       -> IO a
 
-fold = foldWithHandler warnOnError
+foldL links = foldWithHandlerL links warnOnError
     where warnOnError path a err =
               hPutStrLn stderr (path ++ ": " ++ show err) >> return a
 
+-- | 'foldL' without following symlinks
+fold :: RecursionPredicate
+     -> (a -> FileInfo -> a)
+     -> a
+     -> FilePath
+     -> IO a
+fold = foldL False
+
 -- | Unconditionally return 'True'.
 always :: FindClause Bool
 always = return True