Copyright | Bryan O'Sullivan |
---|---|
License | BSD3 |
Maintainer | Bryan O'Sullivan <bos@serpentine.com> |
Stability | unstable |
Portability | Unix-like systems (requires newtype deriving) |
Safe Haskell | None |
Language | Haskell98 |
This module provides functions for traversing a filesystem
hierarchy. The find
function generates a lazy list of matching
files, while fold
performs a left fold.
Both find
and fold
allow fine control over recursion, using the
FindClause
type. This type is also used to pre-filter the results
returned by find
.
The FindClause
type lets you write filtering and recursion
control expressions clearly and easily.
For example, this clause matches C source files.
extension
==?
".c"||?
extension
==?
".h"
Because FindClause
is a monad, you can use the usual monad
machinery to, for example, lift pure functions into it.
Here's a clause that will return True
for any file whose
directory name contains the word "temp"
.
(isInfixOf "temp") `liftM` directory
- data FileInfo = FileInfo {
- infoPath :: FilePath
- infoDepth :: Int
- infoStatus :: FileStatus
- data FileType
- data FindClause a
- type FilterPredicate = FindClause Bool
- type RecursionPredicate = FindClause Bool
- find :: RecursionPredicate -> FilterPredicate -> FilePath -> IO [FilePath]
- fold :: RecursionPredicate -> (a -> FileInfo -> a) -> a -> FilePath -> IO a
- findWithHandler :: (FilePath -> IOException -> IO [FilePath]) -> RecursionPredicate -> FilterPredicate -> FilePath -> IO [FilePath]
- foldWithHandler :: (FilePath -> a -> IOException -> IO a) -> RecursionPredicate -> (a -> FileInfo -> a) -> a -> FilePath -> IO a
- evalClause :: FindClause a -> FileInfo -> a
- statusType :: FileStatus -> FileType
- liftOp :: Monad m => (a -> b -> c) -> m a -> b -> m c
- filePath :: FindClause FilePath
- fileStatus :: FindClause FileStatus
- depth :: FindClause Int
- fileInfo :: FindClause FileInfo
- always :: FindClause Bool
- extension :: FindClause FilePath
- directory :: FindClause FilePath
- fileName :: FindClause FilePath
- fileType :: FindClause FileType
- contains :: FilePath -> FindClause Bool
- deviceID :: FindClause DeviceID
- fileID :: FindClause FileID
- fileOwner :: FindClause UserID
- fileGroup :: FindClause GroupID
- fileSize :: FindClause FileOffset
- linkCount :: FindClause LinkCount
- specialDeviceID :: FindClause DeviceID
- fileMode :: FindClause FileMode
- accessTime :: FindClause EpochTime
- modificationTime :: FindClause EpochTime
- statusChangeTime :: FindClause EpochTime
- filePerms :: FindClause FileMode
- anyPerms :: FileMode -> FindClause Bool
- canonicalPath :: FindClause FilePath
- canonicalName :: FindClause FilePath
- readLink :: FindClause (Maybe FilePath)
- followStatus :: FindClause (Maybe FileStatus)
- (~~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool
- (/~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool
- (==?) :: Eq a => FindClause a -> a -> FindClause Bool
- (/=?) :: Eq a => FindClause a -> a -> FindClause Bool
- (>?) :: Ord a => FindClause a -> a -> FindClause Bool
- (<?) :: Ord a => FindClause a -> a -> FindClause Bool
- (>=?) :: Ord a => FindClause a -> a -> FindClause Bool
- (<=?) :: Ord a => FindClause a -> a -> FindClause Bool
- (.&.?) :: Bits a => FindClause a -> a -> FindClause a
- (&&?) :: FindClause Bool -> FindClause Bool -> FindClause Bool
- (||?) :: FindClause Bool -> FindClause Bool -> FindClause Bool
Documentation
Information collected during the traversal of a directory.
FileInfo | |
|
data FindClause a Source
type FilterPredicate = FindClause Bool Source
type RecursionPredicate = FindClause Bool Source
Simple entry points
:: RecursionPredicate | control recursion into subdirectories |
-> FilterPredicate | decide whether a file appears in the result |
-> FilePath | directory to start searching |
-> IO [FilePath] | files that matched the |
Search a directory recursively, with recursion controlled by a
RecursionPredicate
. Lazily return a sorted list of all files
matching the given FilterPredicate
. Any errors that occur are
ignored, with warnings printed to stderr
.
fold :: RecursionPredicate -> (a -> FileInfo -> a) -> a -> FilePath -> IO a Source
Search a directory recursively, with recursion controlled by a
RecursionPredicate
. Fold over all files found. Any errors that
occur are ignored, with warnings printed to stderr
. The fold
function is run from "left" to "right", so it should be strict
in its left argument to avoid space leaks. If you need a
right-to-left fold, use foldr
on the result of findWithHandler
instead.
More expressive entry points
:: (FilePath -> IOException -> IO [FilePath]) | error handler |
-> RecursionPredicate | control recursion into subdirectories |
-> FilterPredicate | decide whether a file appears in the result |
-> FilePath | directory to start searching |
-> IO [FilePath] | files that matched the |
Search a directory recursively, with recursion controlled by a
RecursionPredicate
. Lazily return a sorted list of all files
matching the given FilterPredicate
. Any errors that occur are
dealt with by the given handler.
:: (FilePath -> a -> IOException -> IO a) | error handler |
-> RecursionPredicate | control recursion into subdirectories |
-> (a -> FileInfo -> a) | function to fold with |
-> a | seed value for fold |
-> FilePath | directory to start searching |
-> IO a | final value after folding |
Search a directory recursively, with recursion controlled by a
RecursionPredicate
. Fold over all files found. Any errors that
occur are dealt with by the given handler. The fold is strict, and
run from "left" to "right", so the folded function should be
strict in its left argument to avoid space leaks. If you need a
right-to-left fold, use foldr
on the result of findWithHandler
instead.
Helper functions
evalClause :: FindClause a -> FileInfo -> a Source
Run the given FindClause
on the given FileInfo
and return its
result. This can be useful if you are writing a function to pass
to fold
.
Example:
myFoldFunc :: a ->FileInfo
-> a myFoldFunc a i = let useThisFile =evalClause
(fileName
==?
"foo") i in if useThisFile then fiddleWith a else a
statusType :: FileStatus -> FileType Source
Return the type of a file. This is much more useful for case
analysis than the usual functions on FileStatus
values.
liftOp :: Monad m => (a -> b -> c) -> m a -> b -> m c Source
Lift a binary operator into the FindClause
monad, so that it
becomes a combinator. The left hand side of the combinator should
be a
, while the right remains a normal value of
type FindClause
aa
.
Combinators for controlling recursion and filtering behaviour
filePath :: FindClause FilePath Source
Return the name of the file being visited.
fileStatus :: FindClause FileStatus Source
Return the FileStatus
for the current file.
depth :: FindClause Int Source
Return the current recursion depth.
fileInfo :: FindClause FileInfo Source
Return the current FileInfo
.
always :: FindClause Bool Source
Unconditionally return True
.
contains :: FilePath -> FindClause Bool Source
Combinator versions of FileStatus
functions from System.Posix.Files
These are simply lifted versions of the FileStatus
accessor
functions in the System.Posix.Files module. The definitions all
have the following form:
deviceID
::FindClause
System.Posix.Types.DeviceIDdeviceID
= System.Posix.Files.deviceID `liftM`fileStatus
Convenience combinators for file status
filePerms :: FindClause FileMode Source
Return the permission bits of the FileMode
.
anyPerms :: FileMode -> FindClause Bool Source
Combinators for canonical path and name
canonicalPath :: FindClause FilePath Source
Return the canonical path of the file being visited.
See canonicalizePath
for details of what canonical path means.
canonicalName :: FindClause FilePath Source
Return the canonical name of the file (canonical path with the directory part removed).
Combinators that operate on symbolic links
followStatus :: FindClause (Maybe FileStatus) Source
If the current file is a symbolic link, return Just
the status
of the ultimate endpoint of the link. Otherwise (including in the
case of an error), return Nothing
.
Example:
statusType
`liftM`followStatus
==?
RegularFile
Common binary operators, lifted as combinators
These are lifted versions of the most commonly used binary
operators. They have the same fixities and associativities as
their unlifted counterparts. They are lifted using liftOp
, like
so:
(==?
) =liftOp
(==)
(~~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool infix 4 Source
Return True
if the current file's name matches the given
GlobPattern
.
(/~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool infix 4 Source
Return True
if the current file's name does not match the given
GlobPattern
.
(==?) :: Eq a => FindClause a -> a -> FindClause Bool infix 4 Source
(/=?) :: Eq a => FindClause a -> a -> FindClause Bool infix 4 Source
(>?) :: Ord a => FindClause a -> a -> FindClause Bool infix 4 Source
(<?) :: Ord a => FindClause a -> a -> FindClause Bool infix 4 Source
(>=?) :: Ord a => FindClause a -> a -> FindClause Bool infix 4 Source
(<=?) :: Ord a => FindClause a -> a -> FindClause Bool infix 4 Source
(.&.?) :: Bits a => FindClause a -> a -> FindClause a infixl 7 Source
This operator is useful to check if bits are set in a
FileMode
.
Combinators for gluing clauses together
(&&?) :: FindClause Bool -> FindClause Bool -> FindClause Bool infixr 3 Source
(||?) :: FindClause Bool -> FindClause Bool -> FindClause Bool infixr 2 Source