-- | Combinators for finding files recursively. The combinators all surround the 'find' function.
module System.Build.FilePather(
                                FilePather,
                                -- * Constructor and unwrapper
                                (<?>),
                                filePather,
                                -- * Values using 'System.FilePath'
                                filePath,
                                always,
                                always',
                                never,
                                never',
                                extension,
                                extension',
                                directory,
                                directory',
                                hasExtension,
                                hasExtension',
                                splitExtension,
                                splitExtension',
                                splitDirectories,
                                splitDirectories',
                                hasTrailingPathSeparator,
                                hasTrailingPathSeparator',
                                fileName,
                                fileName',
                                baseName,
                                baseName',
                                normalise,
                                normalise',
                                makeValid,
                                makeValid',
                                isRelative,
                                isRelative',
                                isAbsolute,
                                isAbsolute',
                                isValid,
                                isValid',
                                -- * Utility
                                not',
                                constant,
                                (==?),
                                (/=?),
                                (==||),
                                (/=||),
                                (==&&),
                                (/=&&),
                                (==>),
                                (===>),
                                (/=>),
                                (/==>),
                                (&&?),
                                (?&&?),
                                (||?),
                                (?||?),
                                -- * Find predicates
                                FileType(..),
                                RecursePredicate,
                                FilterPredicate,
                                isFile,
                                isDirectory,
                                isUnknown,
                                -- * Core function
                                find,
                              ) where

import Prelude hiding (any, all)
import Control.Applicative
import Control.Monad
import Control.Monad.Instances
import Data.Monoid
import Data.Foldable(any, all, Foldable)
import System.FilePath((</>), takeExtension, takeDirectory, takeFileName, takeBaseName)
import System.Directory
import qualified System.FilePath as P

-- | A function that takes a 'FilePath' and produces a value.
newtype FilePather a = FilePather {
  (<?>) :: FilePath -> a
}

instance Functor FilePather where
  fmap f (FilePather k) = FilePather (f . k)

instance Applicative FilePather where
  FilePather f <*> FilePather a = FilePather (f <*> a)
  pure = FilePather . const

instance Monad FilePather where
  FilePather f >>= k = FilePather (f >>= (<?>) . k)
  return = pure

instance (Monoid a) => Monoid (FilePather a) where
  mempty = return mempty
  FilePather x `mappend` FilePather y = FilePather (x `mappend` y)

-- | Construct a 'FilePather' from the given function
filePather :: (FilePath -> a) ->
              FilePather a
filePather = FilePather

-- | A value that runs the identity function.
filePath :: FilePather FilePath
filePath = filePather id

-- | A value that always produces the value 'True'.
always :: FilePather Bool
always = filePather (const True)

-- | A value using a constant function that produces the value 'True'.
always' :: FilePather (a -> Bool)
always' = constant always

-- | A value that always produces the value 'False'.
never :: FilePather Bool
never = filePather (const False)

-- | A value that always produces a constant function that produces the value 'False'.
never' :: FilePather (a -> Bool)
never' = constant never

-- | A value that produces the extension of the given 'FilePath'.
extension :: FilePather FilePath
extension = filePather takeExtension

-- | A value using a constant function that produces the extension of the given 'FilePath'.
extension' :: FilePather (a -> FilePath)
extension' = constant extension

-- | A value that produces the directory of the given 'FilePath'.
directory :: FilePather FilePath
directory = filePather takeDirectory

-- | A value using a constant function that produces the directory of the given 'FilePath'.
directory' :: FilePather (a -> FilePath)
directory' = constant directory

-- | A value that produces a value denoting whether or not the given 'FilePath' has an extension.
hasExtension :: FilePather Bool
hasExtension = filePather P.hasExtension

-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has an extension.
hasExtension' :: FilePather (a -> Bool)
hasExtension' = constant hasExtension

-- | A value that produces a value splitting the given 'FilePath' by its extension.
splitExtension :: FilePather (String, String)
splitExtension = filePather P.splitExtension

-- | A value using a constant function that produces a value splitting the given 'FilePath' by its extension.
splitExtension' :: FilePather (a -> (String, String))
splitExtension' = constant splitExtension

-- | A value that produces a value splitting the given 'FilePath' into its directories.
splitDirectories :: FilePather [FilePath]
splitDirectories = filePather P.splitDirectories

-- | A value using a constant function that produces a value splitting the given 'FilePath' into its directories.
splitDirectories' :: FilePather (a -> [FilePath])
splitDirectories' = constant splitDirectories

-- | A value that produces a value denoting whether or not the given 'FilePath' has a trailing path separator.
hasTrailingPathSeparator :: FilePather Bool
hasTrailingPathSeparator = filePather P.hasTrailingPathSeparator

-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has a trailing path separator.
hasTrailingPathSeparator' :: FilePather (a -> Bool)
hasTrailingPathSeparator' = constant hasTrailingPathSeparator

-- | A value that produces the file name of the given 'FilePath'.
fileName :: FilePather FilePath
fileName = filePather takeFileName

-- | A value using a constant function that produces the file name of the given 'FilePath'.
fileName' :: FilePather (a -> FilePath)
fileName' = constant fileName

-- | A value that produces the base name of the given 'FilePath'.
baseName :: FilePather FilePath
baseName = filePather takeBaseName

-- | A value using a constant function that produces the base name of the given 'FilePath'.
baseName' :: FilePather (a -> FilePath)
baseName' = constant baseName

-- | A value that normalises the given 'FilePath'.
normalise :: FilePather FilePath
normalise = filePather P.normalise

-- | A value using a constant function that normalises the given 'FilePath'.
normalise' :: FilePather (a -> FilePath)
normalise' = constant normalise

-- | A value that makes valid the given 'FilePath'.
makeValid :: FilePather FilePath
makeValid = filePather P.makeValid

-- | A value using a constant function that makes valid the given 'FilePath'.
makeValid' :: FilePather (a -> FilePath)
makeValid' = constant makeValid

-- | A value that produces a value denoting whether or not the given 'FilePath' has is relative.
isRelative :: FilePather Bool
isRelative = filePather P.isRelative

-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has is relative.
isRelative' :: FilePather (a -> Bool)
isRelative' = constant isRelative

-- | A value that produces a value denoting whether or not the given 'FilePath' has is absolute.
isAbsolute :: FilePather Bool
isAbsolute = filePather P.isAbsolute

-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has is absolute.
isAbsolute' :: FilePather (a -> Bool)
isAbsolute' = constant isAbsolute

-- | A value that produces a value denoting whether or not the given 'FilePath' has is valid.
isValid :: FilePather Bool
isValid = filePather P.isValid

-- | A value using a constant function that produces a value denoting whether or not the given 'FilePath' has is valid.
isValid' :: FilePather (a -> Bool)
isValid' = constant isValid

-- | Inverts the given 'Bool' in a functor.
not' :: (Functor f) =>
        f Bool
        -> f Bool
not' = fmap not

-- | Produces a constant function in a functor.
constant :: (Functor f) =>
            f a ->
            f (t -> a)
constant = fmap const

-- | Tests for equality in a functor.
(==?) :: (Eq a, Functor f) =>
         f a
         -> a
         -> f Bool
p ==? a = fmap (a ==) p

-- | Tests for inequality in a functor.
(/=?) :: (Eq a, Functor f) =>
         f a
         -> a
         -> f Bool
p /=? a = fmap (a /=) p

-- | Tests for equality of @any@ values in the given container.
(==||) :: (Eq a, Functor f, Foldable t) =>
          f a ->
          t a ->
          f Bool
p ==|| a = fmap (\x -> any (== x) a) p

-- | Tests for inequality of @any@ values in the given container.
(/=||) :: (Eq a, Functor f, Foldable t) =>
          f a ->
          t a ->
          f Bool
p /=|| a = fmap (\x -> any (/= x) a) p

-- | Tests for equality of @all@ values in the given container.
(==&&) :: (Eq a, Functor f, Foldable t) =>
          f a ->
          t a ->
          f Bool
p ==&& a = fmap (\x -> all (== x) a) p

-- | Tests for inequality of @all@ values in the given container.
(/=&&) :: (Eq a, Functor f, Foldable t) =>
          f a ->
          t a ->
          f Bool
p /=&& a = fmap (\x -> all (/= x) a) p

-- | Tests for implication in an applicative functor.
(==>) :: (Applicative f) =>
         f Bool
         -> f Bool
         -> f Bool
(==>) = liftA2 (\p q -> not p || q)

-- | Tests for implication in an applicative functor in an applicative functor.
(===>) :: (Applicative f1, Applicative f2) =>
          f1 (f2 Bool)
          -> f1 (f2 Bool)
          -> f1 (f2 Bool)
(===>) = liftA2 (==>)

-- | Tests for inverse implication in an applicative functor.
(/=>) :: (Applicative f) =>
         f Bool 
         -> f Bool
         -> f Bool
(/=>) = liftA2 (\p q -> not q && p)

-- | Tests for inverse implication in an applicative functor in an applicative functor.
(/==>) :: (Applicative f1, Applicative f2) =>
          f1 (f2 Bool)
          -> f1 (f2 Bool)
          -> f1 (f2 Bool)
(/==>) = liftA2 (/=>)

-- | Performs conjunction (@AND@) in an applicative functor.
(&&?) :: (Applicative f) =>
         f Bool 
         -> f Bool
         -> f Bool
(&&?) = liftA2 (&&)

-- | Performs conjunction (@AND@) in an applicative functor in an applicative functor.
(?&&?) :: (Applicative f1, Applicative f2) =>
          f1 (f2 Bool)
          -> f1 (f2 Bool)
          -> f1 (f2 Bool)
(?&&?) = liftA2 (&&?)

-- | Performs disjunction (@OR@) in an applicative functor.
(||?) :: (Applicative f) =>
         f Bool
         -> f Bool
         -> f Bool
(||?) = liftA2 (||)

-- | Performs disjunction (@OR@) in an applicative functor in an applicative functor.
(?||?) :: (Applicative f1, Applicative f2) =>
          f1 (f2 Bool)
          -> f1 (f2 Bool)
          -> f1 (f2 Bool)
(?||?) = liftA2 (||?)

-- | The possible types of a file.
data FileType = File -- ^ The type is a normal file.
                | Directory -- ^ The type is a directory.
                | Unknown -- ^ The type is unknown.
  deriving (Eq, Show)

-- | A recurse predicate takes a 'FilePath' and returns whether or not to continue recursing on that file.
type RecursePredicate = FilePather Bool

-- | A filter predicate takes a 'FilePath' and a file type and returns whether or not to filter the value.
type FilterPredicate = FilePather (FileType -> Bool)

-- | Compares for equivalence to a 'File' in an applicative functor.
isFile :: (Applicative f) => 
          f (FileType -> Bool)
isFile = pure (== File)

-- | Compares for equivalence to a 'Directory' in an applicative functor.
isDirectory :: (Applicative f) =>
               f (FileType -> Bool)
isDirectory = pure (== Directory)

-- | Compares for equivalence to 'Unknown' in an applicative functor.
isUnknown :: (Applicative f) => 
             f (FileType -> Bool)
isUnknown = pure (== Unknown)

-- | Finds all files using the given recurse predicate and filter predicate in the given file path.
find :: RecursePredicate -- ^ The recurse predicate determines whether to continue recursing on the given file path.
        -> FilterPredicate -- ^ The filter predicate determines whether to keep the current file path.
        -> FilePath -- ^ The file path to begin finding files.
        -> IO [FilePath] -- ^ All files found.
find = find' []
  where
  find' :: FilePath -> RecursePredicate -> FilterPredicate -> FilePath -> IO [FilePath]
  find' k r x p = let z = if null k then p else k </> p
                      z' t = [z | x <?> z $ t]
                      ifM c t f = do c' <- c
                                     t' <- t
                                     f' <- f
                                     return (if c' then t' else f')
                  in ifM (doesFileExist z)
                       (return (z' File)) $
                       do e <- doesDirectoryExist z
                          if e
                            then if r <?> z
                                   then do c <- getDirectoryContents z
                                           t <- fmap join $ forM (filter (`notElem` [".", ".."]) c) (find' k r x . (z </>))
                                           return (z' Directory ++ t)
                                   else return (z' Directory)
                            else return (z' Unknown)