FileManipCompat 0.13 → 0.14

raw patch · 2 files changed

+388/−69 lines, 2 filesdep −extensible-exceptionsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: extensible-exceptions

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• FileManipCompat.cabal +10/−12
• System/FilePath/FindCompat.hs +378/−57

@@ -1,29 +1,27 @@ Name:               FileManipCompat-Version:            0.13+Version:            0.14 License:            BSD3 License-File:       LICENSE Author:             Bryan O'Sullivan <bos@serpentine.com> Maintainer:         Thomas Hartman <thomashartman1@gmail.com>-Synopsis:           Port of Find function of FileManip lib for use on windows systems+Synopsis:           Expressive file and directory manipulation for Haskell. Category:           System Description:        A Haskell library for working with files and directories.                     Includes code for pattern matching, finding files,                     modifying file contents, and more.-Build-type:         Simple Cabal-version:      >= 1.6+build-type: Simple Extra-Source-Files: README-homepage:            http://patch-tag.com/tphyahoo/r/tphyahoo/FileManipCompat-Flag base4-    Description: Choose the even newer, even smaller, split-up base package. +Flag splitBase+  Description:     Choose the new, split-up base package.+ Library-  Build-Depends: bytestring, directory, filepath, mtl, unix-compat, extensible-exceptions-  if flag(base4)-    Build-Depends:       base >= 4 && < 5+  if flag(splitBase)+    Build-Depends: base <5, bytestring, directory, filepath, mtl, unix-compat   else-    Build-Depends:       base < 4+    Build-Depends: base <4, filepath, mtl, unix-compat -  GHC-Options:    -Wall+  GHC-Options:    -Wall    Exposed-Modules:           System.FilePath.FindCompat-

@@ -1,20 +1,126 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} --- from happstack-util/src/Happstack/Util/FileManip.hs,--- which was derived from FileManip package, which only works on unix.--- happstack port works on windows as well.--- repackage here as standalone to remove dependency on happstack, for immediate use with HStringTemplateHelpers.-module System.FilePath.FindCompat where+-- |+-- 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'+-- @ -import qualified System.PosixCompat.Files as F-import Control.Monad.State-import qualified Control.Exception.Extensible as E-import System.IO+module System.FilePath.FindCompat (+      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+    , (&&?)+    , (||?)+    ) where++import Control.Monad (foldM, forM, liftM, liftM2)+import Control.Monad.State (State(..), evalState)+import Data.Bits (Bits, (.&.)) import Data.List (sort) import System.Directory (getDirectoryContents)-import System.IO.Unsafe (unsafeInterleaveIO)-import System.FilePath ((</>))-import Data.Bits (Bits, (.&.))+import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName)+import System.IO (hPutStrLn, stderr)+import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)+import qualified Control.Exception as E+import qualified System.PosixCompat.Files as F+import qualified System.PosixCompat.Types as T  -- | Information collected during the traversal of a directory. data FileInfo = FileInfo@@ -23,42 +129,13 @@     , infoDepth :: Int -- ^ current recursion depth     , infoStatus :: F.FileStatus -- ^ status of file     } deriving (Eq)-instance Eq F.FileStatus where-    a == b = F.deviceID a == F.deviceID b && F.fileID a == F.fileID b  -data FileType = BlockDevice-              | CharacterDevice-              | NamedPipe-              | RegularFile-              | Directory-              | SymbolicLink-              | Socket-              | Unknown-                deriving (Eq, Ord, Show) --- | Return the type of file currently being visited.------ Example:------ @--- 'fileType' '==?' 'RegularFile'--- @-fileType :: FindClause FileType-fileType = statusType `liftM` fileStatus+instance Eq F.FileStatus where+    a == b = F.deviceID a == F.deviceID b &&+             F.fileID a == F.fileID b --- | 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- -- | Construct a 'FileInfo' value.  mkFI :: FilePath -> Int -> F.FileStatus -> FileInfo@@ -99,11 +176,22 @@  -- | Return the current 'FileInfo'. fileInfo :: FindClause FileInfo+ fileInfo = mkFindClause $ \st -> (st, st) +-- | Return the name of the file being visited.+filePath :: FindClause FilePath +filePath = infoPath `liftM` fileInfo++-- | Return the current recursion depth.+depth :: FindClause Int++depth = infoDepth `liftM` fileInfo+ -- | Return the 'F.FileStatus' for the current file. fileStatus :: FindClause F.FileStatus+ fileStatus = infoStatus `liftM` fileInfo  type FilterPredicate = FindClause Bool@@ -123,27 +211,27 @@ -- matching the given 'FilterPredicate'.  Any errors that occur are -- dealt with by the given handler. findWithHandler ::-    (FilePath -> E.SomeException -> IO [FilePath]) -- ^ error handler+    (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 filt path =+findWithHandler errHandler recurse filter path =     E.handle (errHandler path) $ F.getSymbolicLinkStatus path >>= visit path 0-  where visit path' depth st =-            if F.isDirectory st && evalFI recurse path' depth st-              then unsafeInterleaveIO (traverse path' (succ depth) st)-              else filterPath path' depth st []+  where visit path depth st =+            if F.isDirectory st && evalFI recurse path depth st+              then unsafeInterleaveIO (traverse path (succ depth) st)+              else filterPath path depth st []         traverse dir depth dirSt = do             names <- E.catch (getDirContents dir) (errHandler dir)             filteredPaths <- forM names $ \name -> do-                let path' = dir </> name+                let path = dir </> name                 unsafeInterleaveIO $ E.handle (errHandler path)-                    (F.getSymbolicLinkStatus path' >>= visit path' depth)+                    (F.getSymbolicLinkStatus path >>= visit path depth)             filterPath dir depth dirSt (concat filteredPaths)-        filterPath path' depth st result =-            return $ if evalFI filt path' depth st+        filterPath path depth st result =+            return $ if evalFI filter path depth st                 then path:result                 else result @@ -160,16 +248,237 @@     where warnOnError path err =               hPutStrLn stderr (path ++ ": " ++ show err) >> 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 -> 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) $+        F.getSymbolicLinkStatus path >>= visit state path 0+  where visit state path depth st =+            if F.isDirectory st && evalFI recurse path depth st+            then traverse state path (succ depth) st+            else let state' = f state (mkFI path depth st)+                 in state' `seq` return state'+        traverse state dir depth dirSt = E.handle (errHandler dir state) $+            getDirContents dir >>=+                let state' = f state (mkFI dir depth dirSt)+                in state' `seq` flip foldM state' (\state name ->+                    E.handle (errHandler dir state) $+                    let path = dir </> name+                    in F.getSymbolicLinkStatus path >>= visit state path depth)++-- | 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+     -> IO a++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 name of the file being visited.-filePath :: FindClause FilePath+-- | Return the file name extension.+--+-- Example:+--+-- @+-- 'extension' \"foo\/bar.txt\" => \".txt\"+-- @+extension :: FindClause FilePath+extension = takeExtension `liftM` filePath -filePath = infoPath `liftM` fileInfo+-- | 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+    path <- filePath+    st <- fileStatus+    return $ if F.isSymbolicLink st+        then unsafePerformIO $ E.handle (const (return Nothing)) $+             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++data FileType = BlockDevice+              | CharacterDevice+              | NamedPipe+              | RegularFile+              | Directory+              | SymbolicLink+              | Socket+              | Unknown+                deriving (Eq, Ord, Show)++-- | Return the type of file currently being visited.+--+-- Example:+--+-- @+-- 'fileType' '==?' 'RegularFile'+-- @+fileType :: FindClause FileType++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++fileID :: FindClause T.FileID+fileID = F.fileID `liftM` fileStatus++fileOwner :: FindClause T.UserID+fileOwner = F.fileOwner `liftM` fileStatus++fileGroup :: FindClause T.GroupID+fileGroup = F.fileGroup `liftM` fileStatus++fileSize :: FindClause T.FileOffset+fileSize = F.fileSize `liftM` fileStatus++linkCount :: FindClause T.LinkCount+linkCount = F.linkCount `liftM` fileStatus++specialDeviceID :: FindClause T.DeviceID+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)++accessTime :: FindClause T.EpochTime+accessTime = F.accessTime `liftM` fileStatus++modificationTime :: FindClause T.EpochTime+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+    return $ unsafePerformIO $+        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@@ -187,6 +496,18 @@ --  -- @('==?') = '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 /~?+-}  (==?) :: Eq a => FindClause a -> a -> FindClause Bool (==?) = liftOp (==)