Add docs.

--HG--
extra : convert_revision : 88e724524fcf29c16f7217de5e0886195cbf60ce
This commit is contained in:
Bryan O'Sullivan 2007-05-02 05:56:32 +00:00
parent 37398ede96
commit 0f27317674
2 changed files with 236 additions and 36 deletions

View File

@ -7,6 +7,33 @@
-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
-- Stability: unstable
-- Portability: Unix-like systems (requires newtype deriving)
--
-- 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'
-- @
module System.FilePath.Find (
FileInfo(..)
@ -15,12 +42,20 @@ module System.FilePath.Find (
, FilterPredicate
, RecursionPredicate
-- * Simple entry points
, find
, findWithHandler
, fold
-- * More expressive entry points
, findWithHandler
, foldWithHandler
-- * Helper functions
, evalClause
, statusType
, liftOp
-- * Combinators for controlling recursion and filtering behaviour
, filePath
, fileStatus
, depth
@ -32,6 +67,12 @@ module System.FilePath.Find (
, fileName
, fileType
, contains
-- ** Combinator versions of 'F.FileStatus' functions from "System.Posix.Files"
-- $statusFunctions
, deviceID
, fileID
, fileOwner
@ -40,15 +81,20 @@ module System.FilePath.Find (
, linkCount
, specialDeviceID
, fileMode
, filePerms
, anyPerms
, accessTime
, modificationTime
, statusChangeTime
-- *** Convenience combinators for file status
, filePerms
, anyPerms
-- ** Combinators that operate on symbolic links
, readLink
, followStatus
-- ** Common binary operators, lifted as combinators
-- $binaryOperators
, (~~?)
, (/~?)
, (==?)
@ -57,20 +103,19 @@ module System.FilePath.Find (
, (<?)
, (>=?)
, (<=?)
, (.&.?)
-- ** Combinators for gluing clauses together
, (&&?)
, (||?)
, (.&.?)
) where
import Control.Monad (foldM, forM, liftM, liftM2)
import Control.Monad.Fix (MonadFix)
import Control.Monad.State (State(..), evalState)
import Data.Bits (Bits, (.&.))
import Data.List (sort)
import System.Directory (getDirectoryContents)
import System.FilePath ((</>), replaceFileName, takeDirectory, takeExtension,
takeFileName)
import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName)
import System.FilePath.GlobPattern (GlobPattern, (~~), (/~))
import System.IO (hPutStrLn, stderr)
import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)
@ -102,16 +147,30 @@ mkFI = FileInfo
newtype FindClause a = FC { runFC :: State FileInfo a }
deriving (Functor, Monad)
-- | Run the given find clause and return a pure value.
-- | 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
-- @
evalClause :: FindClause a -> FileInfo -> a
evalClause = evalState . runFC
evalFI :: FindClause a
-> FilePath
-> Int
-> F.FileStatus
-> a
evalFI m p d s = evalState (runFC m) (mkFI p d s)
evalFI m p d s = evalClause m (mkFI p d s)
mkFindClause :: (FileInfo -> (a, FileInfo)) -> FindClause a
mkFindClause = FC . State
-- | Return the current 'FileInfo'.
@ -150,11 +209,12 @@ getDirContents dir = (sort . filter goodName) `liftM` getDirectoryContents dir
-- 'RecursionPredicate'. Lazily return a sorted list of all files
-- matching the given 'FilterPredicate'. Any errors that occur are
-- dealt with by the given handler.
findWithHandler :: (FilePath -> E.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'
findWithHandler ::
(FilePath -> E.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'
findWithHandler errHandler recurse filter path =
E.handle (errHandler path) $ F.getSymbolicLinkStatus path >>= visit path 0
@ -193,12 +253,13 @@ find = findWithHandler warnOnError
-- 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.
foldWithHandler :: (FilePath -> a -> E.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
foldWithHandler
:: (FilePath -> a -> E.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
foldWithHandler errHandler recurse f state path =
E.handle (errHandler path state) $
@ -231,18 +292,56 @@ fold = foldWithHandler warnOnError
where warnOnError path a err =
hPutStrLn stderr (path ++ ": " ++ show err) >> return a
-- | Unconditionally return 'True'.
always :: FindClause Bool
always = return True
-- | Return the file name extension.
--
-- Example:
--
-- @
-- 'extension' \"foo\/bar.txt\" => \".txt\"
-- @
extension :: FindClause FilePath
extension = takeExtension `liftM` filePath
-- | Return the file name, without the directory name.
--
-- What this means in practice:
--
-- @
-- 'fileName' \"foo\/bar.txt\" => \"bar.txt\"
-- @
--
-- Example:
--
-- @
-- 'fileName' '==?' \"init.c\"
-- @
fileName :: FindClause FilePath
fileName = takeFileName `liftM` filePath
-- | 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\"
-- @
directory :: FindClause FilePath
directory = takeDirectory `liftM` filePath
-- | Run the given action in the 'IO' monad (using 'unsafePerformIO')
-- if the current file is a symlink. Hide errors by wrapping results
-- in the 'Maybe' monad.
withLink :: (FilePath -> IO a) -> FindClause (Maybe a)
withLink f = do
@ -253,10 +352,21 @@ withLink f = do
Just `liftM` f path
else Nothing
-- | If the current file is a symbolic link, return 'Just' the target
-- of the link, otherwise 'Nothing'.
readLink :: FindClause (Maybe FilePath)
readLink = withLink F.readSymbolicLink
-- | 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'
-- @
followStatus :: FindClause (Maybe F.FileStatus)
followStatus = withLink F.getFileStatus
@ -271,17 +381,40 @@ data FileType = BlockDevice
| Unknown
deriving (Eq, Ord, Show)
-- | Return the type of file currently being visited.
--
-- Example:
--
-- @
-- 'fileType' '==?' 'RegularFile'
-- @
fileType :: FindClause FileType
fileType = fType `liftM` fileStatus
where fType st | F.isBlockDevice st = BlockDevice
fType st | F.isCharacterDevice st = CharacterDevice
fType st | F.isNamedPipe st = NamedPipe
fType st | F.isRegularFile st = RegularFile
fType st | F.isDirectory st = Directory
fType st | F.isSymbolicLink st = SymbolicLink
fType st | F.isSocket st = Socket
fType _ = Unknown
fileType = statusType `liftM` fileStatus
-- | Return the type of a file. This is much more useful for case
-- analysis than the usual functions on 'F.FileStatus' values.
statusType :: F.FileStatus -> FileType
statusType st | F.isBlockDevice st = BlockDevice
statusType st | F.isCharacterDevice st = CharacterDevice
statusType st | F.isNamedPipe st = NamedPipe
statusType st | F.isRegularFile st = RegularFile
statusType st | F.isDirectory st = Directory
statusType st | F.isSymbolicLink st = SymbolicLink
statusType st | F.isSocket st = Socket
statusType _ = Unknown
-- $statusFunctions
--
-- These are simply lifted versions of the 'F.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'
-- @
deviceID :: FindClause T.DeviceID
deviceID = F.deviceID `liftM` fileStatus
@ -307,9 +440,17 @@ specialDeviceID = F.specialDeviceID `liftM` fileStatus
fileMode :: FindClause T.FileMode
fileMode = F.fileMode `liftM` fileStatus
-- | Return the permission bits of the 'T.FileMode'.
filePerms :: FindClause T.FileMode
filePerms = (.&. 0777) `liftM` fileMode
-- | Return 'True' if any of the given permission bits is set.
--
-- Example:
--
-- @
-- 'anyPerms' 0444
-- @
anyPerms :: T.FileMode
-> FindClause Bool
anyPerms m = filePerms >>= \p -> return (p .&. m /= 0)
@ -323,6 +464,10 @@ modificationTime = F.modificationTime `liftM` fileStatus
statusChangeTime :: FindClause T.EpochTime
statusChangeTime = F.statusChangeTime `liftM` fileStatus
-- | 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.
contains :: FilePath -> FindClause Bool
contains p = do
d <- filePath
@ -330,14 +475,31 @@ contains p = do
E.handle (const (return False)) $
F.getFileStatus (d </> p) >> return True
-- | 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@.
liftOp :: Monad m => (a -> b -> c) -> m a -> b -> m c
liftOp f a b = a >>= \a' -> return (f a' b)
-- $binaryOperators
--
-- 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' (==)@
-- | Return 'True' if the current file's name matches the given
-- 'GlobPattern'.
(~~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool
(~~?) = liftOp (~~)
infix 4 ~~?
-- | Return 'True' if the current file's name does not match the given
-- 'GlobPattern'.
(/~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool
(/~?) = liftOp (/~)
infix 4 /~?
@ -358,10 +520,6 @@ infix 4 >?
(<?) = liftOp (<)
infix 4 <?
(.&.?) :: Bits a => FindClause a -> a -> FindClause a
(.&.?) = liftOp (.&.)
infixl 7 .&.?
(>=?) :: Ord a => FindClause a -> a -> FindClause Bool
(>=?) = liftOp (>=)
infix 4 >=?
@ -370,6 +528,12 @@ infix 4 >=?
(<=?) = liftOp (<=)
infix 4 <=?
-- | This operator is useful to check if bits are set in a
-- 'T.FileMode'.
(.&.?) :: Bits a => FindClause a -> a -> FindClause a
(.&.?) = liftOp (.&.)
infixl 7 .&.?
(&&?) :: FindClause Bool -> FindClause Bool -> FindClause Bool
(&&?) = liftM2 (&&)
infixr 3 &&?

View File

@ -1,5 +1,15 @@
-- |
-- Module: System.FilePath.GlobPattern
-- Copyright: Bryan O'Sullivan
-- License: LGPL
-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
-- Stability: unstable
-- Portability: everywhere
module System.FilePath.GlobPattern (
-- * Glob patterns
-- $syntax
GlobPattern
-- * Matching functions
, (~~)
, (/~)
) where
@ -10,6 +20,29 @@ import Data.List (nub)
import Data.Maybe (isJust)
import System.FilePath (pathSeparator)
-- $syntax
--
-- Basic glob pattern syntax is the same as for the Unix shell
-- environment.
--
-- * @*@ matches everything up to a directory separator or end of
-- string.
--
-- * @[/range/]@ matches any character in /range/.
--
-- * @[!/range/]@ matches any character /not/ in /range/.
--
-- * @\\@ escapes a character that might otherwise have special
-- meaning. For a literal @\"\\\"@ character, use @\"\\\\\"@.
--
-- There are two extensions to the traditional glob syntax, taken from
-- modern Unix shells.
--
-- * @**@ matches everything, including a directory separator.
--
-- * @(/s1/|/s2/|/.../)@ matches any of the strings /s1/, /s2/, etc.
-- | Glob pattern type.
type GlobPattern = String
spanClass :: Char -> String -> (String, String)
@ -132,11 +165,14 @@ matchTerms (MatchDir:ts) cs = matchDir cs >>= matchTerms ts
matchTerms (MatchChar:_) [] = fail "end of input"
matchTerms (MatchChar:ts) (_:cs) = matchTerms ts cs
-- | Match a file name against a glob pattern.
(~~) :: FilePath -> GlobPattern -> Bool
name ~~ pat = let terms = simplifyTerms (parseGlob pat)
in (isJust . matchTerms terms) name
-- | Match a file name against a glob pattern, but return 'True' if
-- the match /fail/s.
(/~) :: FilePath -> GlobPattern -> Bool
(/~) = (not . ) . (~~)