{-# LANGUAGE GeneralizedNewtypeDeriving #-}-- |-- Module: System.FilePath.Find-- Copyright: Bryan O'Sullivan-- License: BSD3-- 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'-- @moduleSystem.FilePath.Find(FileInfo(..),FileType(..),FindClause,FilterPredicate,RecursionPredicate-- * Simple entry points,find,fold-- * More expressive entry points,findWithHandler,foldWithHandler-- * Helper functions,evalClause,statusType,liftOp-- * Combinators for controlling recursion and filtering behaviour,filePath,fileStatus,depth,fileInfo,always,extension,directory,fileName,fileType,contains-- ** Combinator versions of 'F.FileStatus' functions from "System.Posix.Files"-- $statusFunctions,deviceID,fileID,fileOwner,fileGroup,fileSize,linkCount,specialDeviceID,fileMode,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,(~~?),(/~?),(==?),(/=?),(>?),(<?),(>=?),(<=?),(.&.?)-- ** Combinators for gluing clauses together,(&&?),(||?))whereimportControl.Monad(foldM,forM,liftM,liftM2)importControl.Monad.State(State(..),evalState)importData.Bits(Bits,(.&.))importData.List(sort)importSystem.Directory(getDirectoryContents)importSystem.FilePath((</>),takeDirectory,takeExtension,takeFileName)importSystem.FilePath.GlobPattern(GlobPattern,(~~),(/~))importSystem.IO(hPutStrLn,stderr)importSystem.IO.Unsafe(unsafeInterleaveIO,unsafePerformIO)importqualifiedSystem.FilePath.ErrorasEimportqualifiedSystem.Posix.FilesasFimportqualifiedSystem.Posix.TypesasT-- | Information collected during the traversal of a directory.dataFileInfo=FileInfo{infoPath::FilePath-- ^ file path,infoDepth::Int-- ^ current recursion depth,infoStatus::F.FileStatus-- ^ status of file}deriving(Eq)instanceEqF.FileStatuswherea==b=F.deviceIDa==F.deviceIDb&&F.fileIDa==F.fileIDb-- | Construct a 'FileInfo' value.mkFI::FilePath->Int->F.FileStatus->FileInfomkFI=FileInfo-- | Monadic container for file information, allowing for clean-- construction of combinators. Wraps the 'State' monad, but doesn't-- allow 'get' or 'put'.newtypeFindClausea=FC{runFC::StateFileInfoa}deriving(Functor,Monad)-- | 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::FindClausea->FileInfo->aevalClause=evalState.runFCevalFI::FindClausea->FilePath->Int->F.FileStatus->aevalFImpds=evalClausem(mkFIpds)mkFindClause::(FileInfo->(a,FileInfo))->FindClauseamkFindClause=FC.State-- | Return the current 'FileInfo'.fileInfo::FindClauseFileInfofileInfo=mkFindClause$\st->(st,st)-- | Return the name of the file being visited.filePath::FindClauseFilePathfilePath=infoPath`liftM`fileInfo-- | Return the current recursion depth.depth::FindClauseIntdepth=infoDepth`liftM`fileInfo-- | Return the 'F.FileStatus' for the current file.fileStatus::FindClauseF.FileStatusfileStatus=infoStatus`liftM`fileInfotypeFilterPredicate=FindClauseBooltypeRecursionPredicate=FindClauseBool-- | List the files in the given directory, sorted, and without \".\"-- or \"..\".getDirContents::FilePath->IO[FilePath]getDirContentsdir=(sort.filtergoodName)`liftM`getDirectoryContentsdirwheregoodName"."=FalsegoodName".."=FalsegoodName_=True-- | 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.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'findWithHandlererrHandlerrecursefilterpath=E.handle(errHandlerpath)$F.getSymbolicLinkStatuspath>>=visitpath0wherevisitpathdepthst=ifF.isDirectoryst&&evalFIrecursepathdepthstthenunsafeInterleaveIO(traversepath(succdepth)st)elsefilterPathpathdepthst[]traversedirdepthdirSt=donames<-E.catch(getDirContentsdir)(errHandlerdir)filteredPaths<-forMnames$\name->doletpath=dir</>nameunsafeInterleaveIO$E.handle(errHandlerpath)(F.getSymbolicLinkStatuspath>>=visitpathdepth)filterPathdirdepthdirSt(concatfilteredPaths)filterPathpathdepthstresult=return$ifevalFIfilterpathdepthstthenpath:resultelseresult-- | 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'.find::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'find=findWithHandlerwarnOnErrorwherewarnOnErrorpatherr=hPutStrLnstderr(path++": "++showerr)>>return[]-- | 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.foldWithHandler::(FilePath->a->E.Exception->IOa)-- ^ error handler->RecursionPredicate-- ^ control recursion into subdirectories->(a->FileInfo->a)-- ^ function to fold with->a-- ^ seed value for fold->FilePath-- ^ directory to start searching->IOa-- ^ final value after foldingfoldWithHandlererrHandlerrecursefstatepath=E.handle(errHandlerpathstate)$F.getSymbolicLinkStatuspath>>=visitstatepath0wherevisitstatepathdepthst=ifF.isDirectoryst&&evalFIrecursepathdepthstthentraversestatepath(succdepth)stelseletstate'=fstate(mkFIpathdepthst)instate'`seq`returnstate'traversestatedirdepthdirSt=E.handle(errHandlerdirstate)$getDirContentsdir>>=letstate'=fstate(mkFIdirdepthdirSt)instate'`seq`flipfoldMstate'(\statename->E.handle(errHandlerdirstate)$letpath=dir</>nameinF.getSymbolicLinkStatuspath>>=visitstatepathdepth)-- | 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.fold::RecursionPredicate->(a->FileInfo->a)->a->FilePath->IOafold=foldWithHandlerwarnOnErrorwherewarnOnErrorpathaerr=hPutStrLnstderr(path++": "++showerr)>>returna-- | Unconditionally return 'True'.always::FindClauseBoolalways=returnTrue-- | Return the file name extension.---- Example:---- @-- 'extension' \"foo\/bar.txt\" => \".txt\"-- @extension::FindClauseFilePathextension=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::FindClauseFilePathfileName=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::FindClauseFilePathdirectory=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->IOa)->FindClause(Maybea)withLinkf=dopath<-filePathst<-fileStatusreturn$ifF.isSymbolicLinkstthenunsafePerformIO$E.handle(const(returnNothing))$Just`liftM`fpathelseNothing-- | If the current file is a symbolic link, return 'Just' the target-- of the link, otherwise 'Nothing'.readLink::FindClause(MaybeFilePath)readLink=withLinkF.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(MaybeF.FileStatus)followStatus=withLinkF.getFileStatusdataFileType=BlockDevice|CharacterDevice|NamedPipe|RegularFile|Directory|SymbolicLink|Socket|Unknownderiving(Eq,Ord,Show)-- | Return the type of file currently being visited.---- Example:---- @-- 'fileType' '==?' 'RegularFile'-- @fileType::FindClauseFileTypefileType=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->FileTypestatusTypest|F.isBlockDevicest=BlockDevicestatusTypest|F.isCharacterDevicest=CharacterDevicestatusTypest|F.isNamedPipest=NamedPipestatusTypest|F.isRegularFilest=RegularFilestatusTypest|F.isDirectoryst=DirectorystatusTypest|F.isSymbolicLinkst=SymbolicLinkstatusTypest|F.isSocketst=SocketstatusType_=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::FindClauseT.DeviceIDdeviceID=F.deviceID`liftM`fileStatusfileID::FindClauseT.FileIDfileID=F.fileID`liftM`fileStatusfileOwner::FindClauseT.UserIDfileOwner=F.fileOwner`liftM`fileStatusfileGroup::FindClauseT.GroupIDfileGroup=F.fileGroup`liftM`fileStatusfileSize::FindClauseT.FileOffsetfileSize=F.fileSize`liftM`fileStatuslinkCount::FindClauseT.LinkCountlinkCount=F.linkCount`liftM`fileStatusspecialDeviceID::FindClauseT.DeviceIDspecialDeviceID=F.specialDeviceID`liftM`fileStatusfileMode::FindClauseT.FileModefileMode=F.fileMode`liftM`fileStatus-- | Return the permission bits of the 'T.FileMode'.filePerms::FindClauseT.FileModefilePerms=(.&.0777)`liftM`fileMode-- | Return 'True' if any of the given permission bits is set.---- Example:---- @-- 'anyPerms' 0444-- @anyPerms::T.FileMode->FindClauseBoolanyPermsm=filePerms>>=\p->return(p.&.m/=0)accessTime::FindClauseT.EpochTimeaccessTime=F.accessTime`liftM`fileStatusmodificationTime::FindClauseT.EpochTimemodificationTime=F.modificationTime`liftM`fileStatusstatusChangeTime::FindClauseT.EpochTimestatusChangeTime=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->FindClauseBoolcontainsp=dod<-filePathreturn$unsafePerformIO$E.handle(const(returnFalse))$F.getFileStatus(d</>p)>>returnTrue-- | 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::Monadm=>(a->b->c)->ma->b->mcliftOpfab=a>>=\a'->return(fa'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'.(~~?)::FindClauseFilePath->GlobPattern->FindClauseBool(~~?)=liftOp(~~)infix4~~?-- | Return 'True' if the current file's name does not match the given-- 'GlobPattern'.(/~?)::FindClauseFilePath->GlobPattern->FindClauseBool(/~?)=liftOp(/~)infix4/~?(==?)::Eqa=>FindClausea->a->FindClauseBool(==?)=liftOp(==)infix4==?(/=?)::Eqa=>FindClausea->a->FindClauseBool(/=?)=liftOp(/=)infix4/=?(>?)::Orda=>FindClausea->a->FindClauseBool(>?)=liftOp(>)infix4>?(<?)::Orda=>FindClausea->a->FindClauseBool(<?)=liftOp(<)infix4<?(>=?)::Orda=>FindClausea->a->FindClauseBool(>=?)=liftOp(>=)infix4>=?(<=?)::Orda=>FindClausea->a->FindClauseBool(<=?)=liftOp(<=)infix4<=?-- | This operator is useful to check if bits are set in a-- 'T.FileMode'.(.&.?)::Bitsa=>FindClausea->a->FindClausea(.&.?)=liftOp(.&.)infixl7.&.?(&&?)::FindClauseBool->FindClauseBool->FindClauseBool(&&?)=liftM2(&&)infixr3&&?(||?)::FindClauseBool->FindClauseBool->FindClauseBool(||?)=liftM2(||)infixr2||?