module CabalGild.Unstable.Class.MonadWalk where

import qualified System.Directory as Directory
import qualified System.FilePath as FilePath

-- | A 'Monad' that can also walk the file system.
class (Monad m) => MonadWalk m where
  -- | Lists all files in the given directory and its subdirectories
  -- recursively.
  walk :: FilePath -> m [FilePath]

-- | Uses 'listDirectoryRecursively'.
instance MonadWalk IO where
  walk :: FilePath -> IO [FilePath]
walk = FilePath -> IO [FilePath]
listDirectoryRecursively

-- | Lists all files in the given directory and its subdirectories recursively.
-- The order is not guaranteed and may change between different calls. It's
-- also not specified if the results are breadth-first or depth-first.
listDirectoryRecursively :: FilePath -> IO [FilePath]
listDirectoryRecursively :: FilePath -> IO [FilePath]
listDirectoryRecursively FilePath
d = do
  [FilePath]
es <- FilePath -> IO [FilePath]
Directory.listDirectory FilePath
d
  let f :: FilePath -> IO [FilePath]
f FilePath
e = do
        let p :: FilePath
p = FilePath -> FilePath -> FilePath
FilePath.combine FilePath
d FilePath
e
        Bool
b <- FilePath -> IO Bool
Directory.doesDirectoryExist FilePath
p
        if Bool
b
          then FilePath -> IO [FilePath]
listDirectoryRecursively FilePath
p
          else [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
p]
  [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse FilePath -> IO [FilePath]
f [FilePath]
es