{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}

module System.FilePath.FilePather.Find(
  findFiles
, always
, findFilesAlways
) where

import Control.Applicative ( Applicative(liftA2, pure) )
import Control.Category ( Category(id) )
import Control.Lens ( view )
import Control.Monad ( join, Monad((>>=)) )
import System.FilePath.FilePather.Posix
    ( (</>), FilePath, dropTrailingPathSeparator )
import System.IO ( IO )
import Data.Bool ( Bool(True), bool )
import Data.Function(($))
import Data.Functor ( Functor(fmap) )
import Data.Traversable ( Traversable(traverse) )
import Data.Semigroup ( Semigroup((<>)) )
import System.Directory(doesDirectoryExist, listDirectory)
import System.FilePath.FilePather.ReadFilePath
    ( ReadFilePathT(..), readFilePath )

findFiles ::
  ReadFilePathT IO Bool
  -> ReadFilePathT IO [FilePath]
findFiles :: ReadFilePathT IO Bool -> ReadFilePathT IO [FilePath]
findFiles (ReadFilePathT FilePath -> IO Bool
test) =
  let bool' ::
        Monad f =>
        f a
        -> f a
        -> f Bool
        -> f a
      bool' :: f a -> f a -> f Bool -> f a
bool' f a
f f a
t f Bool
p =
        f Bool
p f Bool -> (Bool -> f a) -> f a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f a -> f a -> Bool -> f a
forall a. a -> a -> Bool -> a
bool f a
f f a
t
      partitionM ::
        Applicative m =>
        (a -> m Bool)
        -> [a]
        -> m ([a], [a])
      partitionM :: (a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
_ [] =
        ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
      partitionM a -> m Bool
f (a
x:[a]
xs) =
        (Bool -> ([a], [a]) -> ([a], [a]))
-> m Bool -> m ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
          (\Bool
res ([a]
as, [a]
bs) ->
            let onres :: a -> a -> a
onres a
p a
q =
                  a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
p a
q Bool
res
            in  (([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall a. a -> a -> a
onres [a] -> [a]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [a]
as, ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall a. a -> a -> a
onres (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [a] -> [a]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id [a]
bs)
          )
          (a -> m Bool
f a
x)
          ((a -> m Bool) -> [a] -> m ([a], [a])
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f [a]
xs)
      findFiles' :: FilePath -> FilePath -> IO [FilePath]
findFiles' FilePath
base FilePath
dx =
        IO [FilePath] -> IO [FilePath] -> IO Bool -> IO [FilePath]
forall (f :: * -> *) a. Monad f => f a -> f a -> f Bool -> f a
bool'
          ([FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
          (
            let findFiles'' :: FilePath -> IO [FilePath]
findFiles'' FilePath
dir =
                  let dir' :: FilePath
dir' =
                        FilePath
base FilePath -> FilePath -> FilePath
</> FilePath
dir
                  in  do  ([FilePath]
dirs,[FilePath]
files) <- FilePath -> IO [FilePath]
listDirectory FilePath
dir' IO [FilePath]
-> ([FilePath] -> IO ([FilePath], [FilePath]))
-> IO ([FilePath], [FilePath])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Bool) -> [FilePath] -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM (\FilePath
d -> FilePath -> IO Bool
doesDirectoryExist (FilePath
dir' FilePath -> FilePath -> FilePath
</> FilePath
d))
                          [FilePath]
rest <- ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\FilePath
d -> FilePath -> IO [FilePath]
findFiles'' (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
d)) [FilePath]
dirs)
                          [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
dir FilePath -> FilePath -> FilePath
</>) [FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
rest)
            in  FilePath -> IO [FilePath]
findFiles'' FilePath
dx
          )
          (FilePath -> IO Bool
test (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ Getting
  (FilePath -> FilePath)
  (ReadFilePath FilePath)
  (FilePath -> FilePath)
-> ReadFilePath FilePath -> FilePath -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (FilePath -> FilePath)
  (ReadFilePath FilePath)
  (FilePath -> FilePath)
forall a a'.
Iso
  (ReadFilePath a) (ReadFilePath a') (FilePath -> a) (FilePath -> a')
readFilePath ReadFilePath FilePath
forall (f :: * -> *). Applicative f => ReadFilePathT f FilePath
dropTrailingPathSeparator FilePath
dx)
  in  (FilePath -> IO [FilePath]) -> ReadFilePathT IO [FilePath]
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT (FilePath -> FilePath -> IO [FilePath]
`findFiles'` FilePath
"")

always ::
  Applicative f =>
  ReadFilePathT f Bool
always :: ReadFilePathT f Bool
always =
  (FilePath -> f Bool) -> ReadFilePathT f Bool
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT (f Bool -> FilePath -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True))

findFilesAlways ::
  ReadFilePathT IO [FilePath]
findFilesAlways :: ReadFilePathT IO [FilePath]
findFilesAlways =
  ReadFilePathT IO Bool -> ReadFilePathT IO [FilePath]
findFiles ReadFilePathT IO Bool
forall (f :: * -> *). Applicative f => ReadFilePathT f Bool
always