From 0edef8f7bbfe8e210f546e3222b735a32e6055e3 Mon Sep 17 00:00:00 2001
From: rhiannon morris <rhi@rhiannon.website>
Date: Fri, 16 Apr 2021 21:29:00 +0200
Subject: [PATCH] add flag to follow symlinks when recursing

---
 System/FilePath/Find.hs | 78 ++++++++++++++++++++++++++++++++---------
 1 file changed, 61 insertions(+), 17 deletions(-)

diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs
index 547e2e6..348103e 100644
--- a/System/FilePath/Find.hs
+++ b/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,18 +245,38 @@ 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'.
+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'
+
+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 = findWithHandler warnOnError
-    where warnOnError path err =
-              hPutStrLn stderr (path ++ ": " ++ show err) >> return []
+find = findL False
 
 -- | Search a directory recursively, with recursion controlled by a
 -- 'RecursionPredicate'.  Fold over all files found.  Any errors that
@@ -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,15 +326,24 @@ 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.
+foldL :: Bool -- ^ follow symlinks
+      -> RecursionPredicate
+      -> (a -> FileInfo -> a)
+      -> a
+      -> FilePath
+      -> IO a
+
+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 = foldWithHandler warnOnError
-    where warnOnError path a err =
-              hPutStrLn stderr (path ++ ": " ++ show err) >> return a
+fold = foldL False
 
 -- | Unconditionally return 'True'.
 always :: FindClause Bool