Fix the type signature of fold, and clean up other names.
--HG-- extra : convert_revision : 33c7ae5ca3ffad927894cb36d4ba4fc4729c76f2
This commit is contained in:
parent
4a365311e6
commit
a5675ac014
1 changed files with 28 additions and 13 deletions
|
@ -1,7 +1,8 @@
|
||||||
{-# OPTIONS_GHC -fglasgow-exts #-}
|
{-# OPTIONS_GHC -fglasgow-exts #-}
|
||||||
|
|
||||||
module System.FilePath.Find (
|
module System.FilePath.Find (
|
||||||
FileType(..)
|
FileInfo(..)
|
||||||
|
, FileType(..)
|
||||||
, FindClause
|
, FindClause
|
||||||
, FilterPredicate
|
, FilterPredicate
|
||||||
, RecursionPredicate
|
, RecursionPredicate
|
||||||
|
@ -15,6 +16,7 @@ module System.FilePath.Find (
|
||||||
, filePath
|
, filePath
|
||||||
, fileStatus
|
, fileStatus
|
||||||
, depth
|
, depth
|
||||||
|
, fileInfo
|
||||||
|
|
||||||
, always
|
, always
|
||||||
, extension
|
, extension
|
||||||
|
@ -66,9 +68,18 @@ import qualified Control.Exception as E
|
||||||
import qualified System.Posix.Files as F
|
import qualified System.Posix.Files as F
|
||||||
import qualified System.Posix.Types as T
|
import qualified System.Posix.Types as T
|
||||||
|
|
||||||
type Info = (FilePath, Int, F.FileStatus)
|
data FileInfo = FileInfo
|
||||||
|
{
|
||||||
|
infoPath :: FilePath
|
||||||
|
, infoDepth :: Int
|
||||||
|
, infoStatus :: F.FileStatus
|
||||||
|
}
|
||||||
|
|
||||||
newtype FindClause a = FI { runFI :: State Info a }
|
mkFI :: FilePath -> Int -> F.FileStatus -> FileInfo
|
||||||
|
|
||||||
|
mkFI = FileInfo
|
||||||
|
|
||||||
|
newtype FindClause a = FI { runFI :: State FileInfo a }
|
||||||
deriving (Functor, Monad, MonadFix)
|
deriving (Functor, Monad, MonadFix)
|
||||||
|
|
||||||
evalFI :: FindClause a
|
evalFI :: FindClause a
|
||||||
|
@ -77,23 +88,27 @@ evalFI :: FindClause a
|
||||||
-> F.FileStatus
|
-> F.FileStatus
|
||||||
-> a
|
-> a
|
||||||
|
|
||||||
evalFI m p d s = evalState (runFI m) (p, d, s)
|
evalFI m p d s = evalState (runFI m) (mkFI p d s)
|
||||||
|
|
||||||
mkFI :: (Info -> (a, Info)) -> FindClause a
|
mkFindClause :: (FileInfo -> (a, FileInfo)) -> FindClause a
|
||||||
|
|
||||||
mkFI = FI . State
|
mkFindClause = FI . State
|
||||||
|
|
||||||
|
fileInfo :: FindClause FileInfo
|
||||||
|
|
||||||
|
fileInfo = mkFindClause $ \st -> (st, st)
|
||||||
|
|
||||||
filePath :: FindClause FilePath
|
filePath :: FindClause FilePath
|
||||||
|
|
||||||
filePath = mkFI $ \st@(p, _, _) -> (p, st)
|
filePath = infoPath `liftM` fileInfo
|
||||||
|
|
||||||
depth :: FindClause Int
|
depth :: FindClause Int
|
||||||
|
|
||||||
depth = mkFI $ \st@(_, d, _) -> (d, st)
|
depth = infoDepth `liftM` fileInfo
|
||||||
|
|
||||||
fileStatus :: FindClause F.FileStatus
|
fileStatus :: FindClause F.FileStatus
|
||||||
|
|
||||||
fileStatus = mkFI $ \st@(_, _, s) -> (s, st)
|
fileStatus = infoStatus `liftM` fileInfo
|
||||||
|
|
||||||
type FilterPredicate = FindClause Bool
|
type FilterPredicate = FindClause Bool
|
||||||
type RecursionPredicate = FindClause Bool
|
type RecursionPredicate = FindClause Bool
|
||||||
|
@ -140,7 +155,7 @@ find = findWithHandler warnOnError
|
||||||
|
|
||||||
foldWithHandler :: (FilePath -> a -> E.Exception -> IO a)
|
foldWithHandler :: (FilePath -> a -> E.Exception -> IO a)
|
||||||
-> RecursionPredicate
|
-> RecursionPredicate
|
||||||
-> (a -> FindClause a)
|
-> (a -> FileInfo -> a)
|
||||||
-> a
|
-> a
|
||||||
-> FilePath
|
-> FilePath
|
||||||
-> IO a
|
-> IO a
|
||||||
|
@ -151,16 +166,16 @@ foldWithHandler errHandler recurse f state path =
|
||||||
where visit state path depth st =
|
where visit state path depth st =
|
||||||
if F.isDirectory st && evalFI recurse path depth st
|
if F.isDirectory st && evalFI recurse path depth st
|
||||||
then traverse state path (succ depth) st
|
then traverse state path (succ depth) st
|
||||||
else return (evalFI (f state) path depth st)
|
else return (f state (mkFI path depth st))
|
||||||
traverse state dir depth dirSt = E.handle (errHandler dir state) $
|
traverse state dir depth dirSt = E.handle (errHandler dir state) $
|
||||||
getDirContents dir >>=
|
getDirContents dir >>=
|
||||||
flip foldM (evalFI (f state) dir depth dirSt) (\state name ->
|
flip foldM (f state (mkFI dir depth dirSt)) (\state name ->
|
||||||
E.handle (errHandler dir state) $
|
E.handle (errHandler dir state) $
|
||||||
let path = dir </> name
|
let path = dir </> name
|
||||||
in F.getSymbolicLinkStatus path >>= visit state path depth)
|
in F.getSymbolicLinkStatus path >>= visit state path depth)
|
||||||
|
|
||||||
fold :: RecursionPredicate
|
fold :: RecursionPredicate
|
||||||
-> (a -> FindClause a)
|
-> (a -> FileInfo -> a)
|
||||||
-> a
|
-> a
|
||||||
-> FilePath
|
-> FilePath
|
||||||
-> IO a
|
-> IO a
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue