-- | Adapted from how Shelly does finding in Shelly.Find
-- (shelly is BSD-licensed)

module System.FSNotify.Find where

import Control.Monad
import Control.Monad.IO.Class
import System.Directory (doesDirectoryExist, listDirectory, pathIsSymbolicLink)
import System.FilePath

find :: Bool -> FilePath -> IO [FilePath]
find :: Bool -> FilePath -> IO [FilePath]
find Bool
followSymlinks = Bool -> [FilePath] -> FilePath -> IO [FilePath]
find' Bool
followSymlinks  []

find' :: Bool -> [FilePath] -> FilePath -> IO [FilePath]
find' :: Bool -> [FilePath] -> FilePath -> IO [FilePath]
find' Bool
followSymlinks [FilePath]
startValue FilePath
dir = do
  ([FilePath]
rPaths, [FilePath]
aPaths) <- FilePath -> IO ([FilePath], [FilePath])
lsRelAbs FilePath
dir
  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [FilePath] -> (FilePath, FilePath) -> IO [FilePath]
visit [FilePath]
startValue (forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
rPaths [FilePath]
aPaths)
  where
    visit :: [FilePath] -> (FilePath, FilePath) -> IO [FilePath]
visit [FilePath]
acc (FilePath
relativePath, FilePath
absolutePath) = do
      Bool
isDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
absolutePath
      Bool
sym <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
pathIsSymbolicLink FilePath
absolutePath
      let newAcc :: [FilePath]
newAcc = FilePath
relativePath forall a. a -> [a] -> [a]
: [FilePath]
acc
      if Bool
isDir Bool -> Bool -> Bool
&& (Bool
followSymlinks Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
sym)
        then Bool -> [FilePath] -> FilePath -> IO [FilePath]
find' Bool
followSymlinks [FilePath]
newAcc FilePath
relativePath
        else forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
newAcc

lsRelAbs :: FilePath -> IO ([FilePath], [FilePath])
lsRelAbs :: FilePath -> IO ([FilePath], [FilePath])
lsRelAbs FilePath
fp = do
  [FilePath]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
fp
  let absolute :: [FilePath]
absolute = forall a b. (a -> b) -> [a] -> [b]
map (FilePath
fp FilePath -> FilePath -> FilePath
</>) [FilePath]
files
  let relativized :: [FilePath]
relativized = forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
p -> [FilePath] -> FilePath
joinPath [FilePath
fp, FilePath
p]) [FilePath]
files
  forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
relativized, [FilePath]
absolute)