module System.Build.FilePather(
FilePather,
(<?>),
filePather,
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',
not',
constant,
(==?),
(/=?),
(==||),
(/=||),
(==&&),
(/=&&),
(==>),
(===>),
(/=>),
(/==>),
(&&?),
(?&&?),
(||?),
(?||?),
FileType(..),
RecursePredicate,
FilterPredicate,
isFile,
isDirectory,
isUnknown,
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
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)
filePather :: (FilePath -> a) ->
FilePather a
filePather = FilePather
filePath :: FilePather FilePath
filePath = filePather id
always :: FilePather Bool
always = filePather (const True)
always' :: FilePather (a -> Bool)
always' = constant always
never :: FilePather Bool
never = filePather (const False)
never' :: FilePather (a -> Bool)
never' = constant never
extension :: FilePather FilePath
extension = filePather takeExtension
extension' :: FilePather (a -> FilePath)
extension' = constant extension
directory :: FilePather FilePath
directory = filePather takeDirectory
directory' :: FilePather (a -> FilePath)
directory' = constant directory
hasExtension :: FilePather Bool
hasExtension = filePather P.hasExtension
hasExtension' :: FilePather (a -> Bool)
hasExtension' = constant hasExtension
splitExtension :: FilePather (String, String)
splitExtension = filePather P.splitExtension
splitExtension' :: FilePather (a -> (String, String))
splitExtension' = constant splitExtension
splitDirectories :: FilePather [FilePath]
splitDirectories = filePather P.splitDirectories
splitDirectories' :: FilePather (a -> [FilePath])
splitDirectories' = constant splitDirectories
hasTrailingPathSeparator :: FilePather Bool
hasTrailingPathSeparator = filePather P.hasTrailingPathSeparator
hasTrailingPathSeparator' :: FilePather (a -> Bool)
hasTrailingPathSeparator' = constant hasTrailingPathSeparator
fileName :: FilePather FilePath
fileName = filePather takeFileName
fileName' :: FilePather (a -> FilePath)
fileName' = constant fileName
baseName :: FilePather FilePath
baseName = filePather takeBaseName
baseName' :: FilePather (a -> FilePath)
baseName' = constant baseName
normalise :: FilePather FilePath
normalise = filePather P.normalise
normalise' :: FilePather (a -> FilePath)
normalise' = constant normalise
makeValid :: FilePather FilePath
makeValid = filePather P.makeValid
makeValid' :: FilePather (a -> FilePath)
makeValid' = constant makeValid
isRelative :: FilePather Bool
isRelative = filePather P.isRelative
isRelative' :: FilePather (a -> Bool)
isRelative' = constant isRelative
isAbsolute :: FilePather Bool
isAbsolute = filePather P.isAbsolute
isAbsolute' :: FilePather (a -> Bool)
isAbsolute' = constant isAbsolute
isValid :: FilePather Bool
isValid = filePather P.isValid
isValid' :: FilePather (a -> Bool)
isValid' = constant isValid
not' :: (Functor f) =>
f Bool
-> f Bool
not' = fmap not
constant :: (Functor f) =>
f a ->
f (t -> a)
constant = fmap const
(==?) :: (Eq a, Functor f) =>
f a
-> a
-> f Bool
p ==? a = fmap (a ==) p
(/=?) :: (Eq a, Functor f) =>
f a
-> a
-> f Bool
p /=? a = fmap (a /=) p
(==||) :: (Eq a, Functor f, Foldable t) =>
f a ->
t a ->
f Bool
p ==|| a = fmap (\x -> any (== x) a) p
(/=||) :: (Eq a, Functor f, Foldable t) =>
f a ->
t a ->
f Bool
p /=|| a = fmap (\x -> any (/= x) a) p
(==&&) :: (Eq a, Functor f, Foldable t) =>
f a ->
t a ->
f Bool
p ==&& a = fmap (\x -> all (== x) a) p
(/=&&) :: (Eq a, Functor f, Foldable t) =>
f a ->
t a ->
f Bool
p /=&& a = fmap (\x -> all (/= x) a) p
(==>) :: (Applicative f) =>
f Bool
-> f Bool
-> f Bool
(==>) = liftA2 (\p q -> not p || q)
(===>) :: (Applicative f1, Applicative f2) =>
f1 (f2 Bool)
-> f1 (f2 Bool)
-> f1 (f2 Bool)
(===>) = liftA2 (==>)
(/=>) :: (Applicative f) =>
f Bool
-> f Bool
-> f Bool
(/=>) = liftA2 (\p q -> not q && p)
(/==>) :: (Applicative f1, Applicative f2) =>
f1 (f2 Bool)
-> f1 (f2 Bool)
-> f1 (f2 Bool)
(/==>) = liftA2 (/=>)
(&&?) :: (Applicative f) =>
f Bool
-> f Bool
-> f Bool
(&&?) = liftA2 (&&)
(?&&?) :: (Applicative f1, Applicative f2) =>
f1 (f2 Bool)
-> f1 (f2 Bool)
-> f1 (f2 Bool)
(?&&?) = liftA2 (&&?)
(||?) :: (Applicative f) =>
f Bool
-> f Bool
-> f Bool
(||?) = liftA2 (||)
(?||?) :: (Applicative f1, Applicative f2) =>
f1 (f2 Bool)
-> f1 (f2 Bool)
-> f1 (f2 Bool)
(?||?) = liftA2 (||?)
data FileType = File
| Directory
| Unknown
deriving (Eq, Show)
type RecursePredicate = FilePather Bool
type FilterPredicate = FilePather (FileType -> Bool)
isFile :: (Applicative f) =>
f (FileType -> Bool)
isFile = pure (== File)
isDirectory :: (Applicative f) =>
f (FileType -> Bool)
isDirectory = pure (== Directory)
isUnknown :: (Applicative f) =>
f (FileType -> Bool)
isUnknown = pure (== Unknown)
find :: RecursePredicate
-> FilterPredicate
-> FilePath
-> IO [FilePath]
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)