module System.FilePath.FilePather.Find
(
Find(..)
, findi
, findpi
, FindR
, foundR
, dropR
, recurseR
, noRecurseR
, foundL
, dropL
, recurseL
, noRecurseL
) where
import Control.Monad.Identity
import Control.Monad.Trans.Identity
import Control.Comonad
import Control.Comonad.Trans.Store
import Data.Lens.Partial.Common hiding (null)
import System.FilePath
import System.FilePath.FilePather.RecursePredicate
import System.FilePath.FilePather.FilterPredicate
import System.FilePath.FilePather.FileType
import System.Directory
class Find f where
find ::
FilterPredicateT f
-> RecursePredicateT f
-> FilePath
-> IO [FindR]
findHere ::
FilterPredicateT f
-> RecursePredicateT f
-> IO [FindR]
findHere f r =
getCurrentDirectory >>= find f r
findp ::
FilterPredicateT f
-> RecursePredicateT f
-> FilePath
-> IO [FilePath]
findp f r =
liftM (\x -> x >>= \w ->
case w of
Found p _ -> [p]
Drop _ _ -> []
Recurse _ -> []
NoRecurse _ -> []) . find f r
findpHere ::
FilterPredicateT f
-> RecursePredicateT f
-> IO [FilePath]
findpHere f r =
getCurrentDirectory >>= findp f r
instance Find Identity where
find f' r' =
let find' base p =
let f =
runFilterPredicateT f'
r =
runRecursePredicateT r'
z ::
FilePath
z =
if null base then p else base </> p
keep ::
Bool
-> FileType
-> FindR
keep u =
(if u then Found else Drop) z
rkeep ::
Bool
-> FindR
rkeep u =
(if u then Recurse else NoRecurse) z
tkeep ::
FileType
-> [FindR]
tkeep t =
[keep (runIdentity (f z t)) t]
in do fe <- doesFileExist z
if fe
then
return (tkeep File)
else
do de <- doesDirectoryExist z
if de
then
let (Identity k) = f z Directory
(Identity l) = r z
in liftM ([rkeep l, keep k Directory] ++) $
if l
then
do t <- getDirectoryContents z
u <- forM (filter (`notElem` [".", ".."]) t) (find f' r' . (z </>))
return (concat u)
else
return []
else
return (tkeep Unknown)
in find' []
instance Find IO where
find f' r' =
let find' base p =
let f =
runFilterPredicateT f'
r =
runRecursePredicateT r'
z ::
FilePath
z =
if null base then p else base </> p
keep ::
Bool
-> FileType
-> FindR
keep u =
(if u then Found else Drop) z
rkeep ::
Bool
-> FindR
rkeep u =
(if u then Recurse else NoRecurse) z
tkeep ::
FileType
-> IO [FindR]
tkeep t =
f z t >>= \y -> return [keep y t]
in do fe <- doesFileExist z
if fe
then
tkeep File
else
do de <- doesDirectoryExist z
if de
then
do k <- f z Directory
l <- r z
liftM ([rkeep l, keep k Directory] ++) $
if l
then
do t <- getDirectoryContents z
u <- forM (filter (`notElem` [".", ".."]) t) (find f' r' . (z </>))
return (concat u)
else
return []
else
tkeep Unknown
in find' []
instance Comonad f => Find (IdentityT f) where
find f r =
find (filterPredicateT $ \p -> Identity . extract . runFilterPredicateT f p) (recursePredicateT $ Identity . extract . runRecursePredicateT r)
findi ::
FilterPredicate
-> RecursePredicate
-> FilePath
-> IO [FindR]
findi =
find
findpi ::
FilterPredicate
-> RecursePredicate
-> FilePath
-> IO [FilePath]
findpi =
findp
data FindR =
Found FilePath FileType
| Drop FilePath FileType
| Recurse FilePath
| NoRecurse FilePath
deriving (Eq, Show)
foundR ::
FilePath
-> FileType
-> FindR
foundR =
Found
dropR ::
FilePath
-> FileType
-> FindR
dropR =
Drop
recurseR ::
FilePath
-> FindR
recurseR =
Recurse
noRecurseR ::
FilePath
-> FindR
noRecurseR =
NoRecurse
foundL ::
PartialLens FindR (FilePath, FileType)
foundL =
PLens $ \r ->
case r of
Found p t -> Just (store (uncurry Found) (p, t))
_ -> Nothing
dropL ::
PartialLens FindR (FilePath, FileType)
dropL =
PLens $ \r ->
case r of
Drop p t -> Just (store (uncurry Drop) (p, t))
_ -> Nothing
recurseL ::
PartialLens FindR FilePath
recurseL =
PLens $ \r ->
case r of
Recurse p -> Just (store Recurse p)
_ -> Nothing
noRecurseL ::
PartialLens FindR FilePath
noRecurseL =
PLens $ \r ->
case r of
NoRecurse p -> Just (store NoRecurse p)
_ -> Nothing