Find.hs

{-# 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)