FileManipCompat-0.15: Expressive file and directory manipulation for Haskell.

PortabilityUnix-like systems (requires newtype deriving)
Stabilityunstable
MaintainerBryan O'Sullivan <bos@serpentine.com>

System.FilePath.FindCompat

Contents

Description

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 False for any file whose directory name contains the word "temp".

 (isInfixOf "temp") `liftM` directory

Synopsis

Documentation

data FileInfo Source

Information collected during the traversal of a directory.

Constructors

FileInfo 

Fields

infoPath :: FilePath

file path

infoDepth :: Int

current recursion depth

infoStatus :: FileStatus

status of file

Instances

data FindClause a Source

Monadic container for file information, allowing for clean construction of combinators. Wraps the State monad, but doesn't allow get or put.

Simple entry points

findSource

Arguments

:: 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 FilterPredicate

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 aSource

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

findWithHandlerSource

Arguments

:: (FilePath -> Exception -> 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 FilterPredicate

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.

foldWithHandlerSource

Arguments

:: (FilePath -> a -> Exception -> 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 -> aSource

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 -> FileTypeSource

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 cSource

Lift a binary operator into the FindClause monad, so that it becomes a combinator. The left hand side of the combinator should be a FindClause a, while the right remains a normal value of type a.

Combinators for controlling recursion and filtering behaviour

filePath :: FindClause FilePathSource

Return the name of the file being visited.

fileStatus :: FindClause FileStatusSource

Return the FileStatus for the current file.

depth :: FindClause IntSource

Return the current recursion depth.

always :: FindClause BoolSource

Unconditionally return True.

extension :: FindClause FilePathSource

Return the file name extension.

Example:

 extension "foo/bar.txt" => ".txt"

directory :: FindClause FilePathSource

Return the directory name, without the file name.

What this means in practice:

 directory "foo/bar.txt" => "foo"

Example in a clause:

 let hasSuffix = liftOp isSuffixOf
 in directory `hasSuffix` "tests"

fileName :: FindClause FilePathSource

Return the file name, without the directory name.

What this means in practice:

 fileName "foo/bar.txt" => "bar.txt"

Example:

 fileName ==? "init.c"

fileType :: FindClause FileTypeSource

Return the type of file currently being visited.

Example:

 fileType ==? RegularFile

contains :: FilePath -> FindClause BoolSource

Return True if the given path exists, relative to the current file. For example, if "foo" is being visited, and you call contains "bar", this combinator will return True if "foo/bar" exists.

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.DeviceID
 deviceID = System.Posix.Files.deviceID `liftM` fileStatus

Convenience combinators for file status

filePerms :: FindClause FileModeSource

Return the permission bits of the FileMode.

anyPerms :: FileMode -> FindClause BoolSource

Return True if any of the given permission bits is set.

Example:

 anyPerms 0444

Combinators that operate on symbolic links

readLink :: FindClause (Maybe FilePath)Source

If the current file is a symbolic link, return Just the target of the link, otherwise Nothing.

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 (==)

(==?) :: Eq a => FindClause a -> a -> FindClause BoolSource

Return True if the current file's name matches the given GlobPattern.

(.&.?) :: Bits a => FindClause a -> a -> FindClause aSource

This operator is useful to check if bits are set in a FileMode.

Combinators for gluing clauses together