{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-} module System.FilePath.FilePather.Find( findWith , findDirectories , findAll , findAllFiles ) where import Control.Applicative ( Applicative(pure) ) import Control.Category ( Category((.)) ) import Control.Exception ( Exception ) import Control.Lens ( view, _Wrapped ) import Control.Monad ( Monad((>>=)), filterM ) import Control.Monad.IO.Class ( MonadIO(liftIO) ) import Control.Monad.Reader ( MonadReader(local, ask) ) import Data.Bool ( Bool(True) ) import Data.Foldable ( fold ) import Data.Functor ( Functor(fmap), (<$>) ) import Data.Semigroup ( Semigroup((<>)) ) import Data.Traversable ( Traversable(traverse) ) import System.FilePath ( FilePath, () ) import System.FilePath.FilePather.Directory ( listDirectory, doesFileExist, doesDirectoryExist ) import System.FilePath.FilePather.ReadFilePath ( ReadFilePathT ) import System.IO ( IO ) import System.IO.Unsafe( unsafeInterleaveIO ) findWith :: Exception e => ReadFilePathT e IO Bool -> ReadFilePathT e IO [FilePath] findWith p = let setl = local . pure in do z <- ask a <- listDirectory b <- filterM (`setl` p) ((z ) <$> a) d <- filterM (`setl` doesDirectoryExist) b case d of [] -> pure b _ -> do n <- liftIO (unsafeInterleaveIO (fmap (>>= fold) (traverse (view _Wrapped (findWith p)) d))) pure (b <> n) findDirectories :: Exception e => ReadFilePathT e IO [FilePath] findDirectories = findWith doesDirectoryExist findAll :: Exception e => ReadFilePathT e IO [FilePath] findAll = findWith (pure True) findAllFiles :: Exception e => ReadFilePathT e IO [FilePath] findAllFiles = findAll >>= filterM (\p -> local (pure p) doesFileExist)