From 7cc61dc7f77a2f782406cb1a8ba57f1fd009aff8 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 04:49:33 +0000 Subject: [PATCH 01/67] Initial cut of filemanip library. --HG-- extra : convert_revision : b8e8b5bb7f26a1b0a2322964f2dbe898cb8c6161 --- FileManip.cabal | 14 ++++++++++++++ Setup.lhs | 3 +++ 2 files changed, 17 insertions(+) create mode 100644 FileManip.cabal create mode 100644 Setup.lhs diff --git a/FileManip.cabal b/FileManip.cabal new file mode 100644 index 0000000..e5b38d8 --- /dev/null +++ b/FileManip.cabal @@ -0,0 +1,14 @@ +Name: FileManip +Version: 0.1 +License: LGPL +Author: Bryan O'Sullivan +Maintainer: Bryan O'Sullivan +Synopsis: File and directory manipulation library for Haskell +Category: System +Description: A Haskell library for working with files and directories. + Includes modules for pattern matching, finding files, + and more. +Build-Depends: base, filepath, unix +Exposed-Modules: + System.FilePath.Find, + System.FilePath.Glob diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 index 0000000..5bde0de --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain From 460b27badcecab12f25ff98f4229ea38cf05dd8a Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 06:30:30 +0000 Subject: [PATCH 02/67] Add new files. --HG-- extra : convert_revision : 3b8798ab5761cade42d7f59897f5c0c8564399b2 --- System/FilePath/Find.hs | 338 ++++++++++++++++++++++++++++++++++++++++ System/FilePath/Glob.hs | 137 ++++++++++++++++ 2 files changed, 475 insertions(+) create mode 100644 System/FilePath/Find.hs create mode 100644 System/FilePath/Glob.hs diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs new file mode 100644 index 0000000..e612180 --- /dev/null +++ b/System/FilePath/Find.hs @@ -0,0 +1,338 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} + +module System.FilePath.Find ( + FileType(..) + , FindClause + , FilterPredicate + , RecursionPredicate + + , find + , findWithHandler + + , fold + , foldWithHandler + + , filePath + , fileStatus + , depth + + , always + , extension + , directory + , fileName + + , fileType + , deviceID + , fileID + , fileOwner + , fileGroup + , fileSize + , linkCount + , specialDeviceID + , fileMode + , filePerms + , anyPerms + , accessTime + , modificationTime + , statusChangeTime + + , (~?) + , (/~?) + , (==?) + , (/=?) + , (>?) + , (=?) + , (<=?) + , (&&?) + , (||?) + ) where + +import qualified Control.Exception as E +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 ((), takeDirectory, takeExtension, takeFileName) +import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) +import System.IO (hPutStrLn, stderr) +import qualified System.Posix.Files as F +import qualified System.Posix.Types as T +import qualified System.FilePath.Glob as G + +type Info = (FilePath, Int, F.FileStatus) + +newtype FindClause a = FI { runFI :: State Info a } + deriving (Functor, Monad, MonadFix) + +evalFI :: FindClause a + -> FilePath + -> Int + -> F.FileStatus + -> a + +evalFI m p d s = evalState (runFI m) (p, d, s) + +mkFI = FI . State + +filePath :: FindClause FilePath + +filePath = mkFI $ \st@(p, _, _) -> (p, st) + +fileStatus :: FindClause F.FileStatus + +fileStatus = mkFI $ \st@(_, _, s) -> (s, st) + +depth :: FindClause Int + +depth = mkFI $ \st@(_, d, _) -> (d, st) + +type FilterPredicate = FindClause Bool +type RecursionPredicate = FindClause Bool + +getDirContents :: FilePath -> IO [FilePath] + +getDirContents dir = (sort . filter goodName) `liftM` getDirectoryContents dir + where goodName "." = False + goodName ".." = False + goodName _ = True + +findWithHandler :: (FilePath -> E.Exception -> IO [FilePath]) + -> RecursionPredicate + -> FilterPredicate + -> FilePath + -> IO [FilePath] + +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 [] + traverse dir depth dirSt = do + names <- E.catch (getDirContents dir) (errHandler dir) + filteredPaths <- forM names $ \name -> do + let path = dir name + unsafeInterleaveIO $ E.handle (errHandler path) + (F.getSymbolicLinkStatus path >>= visit path depth) + filterPath dir depth dirSt (concat filteredPaths) + filterPath path depth st result = + return $ if evalFI filter path depth st + then path:result + else result + +find :: RecursionPredicate + -> FilterPredicate + -> FilePath + -> IO [FilePath] + +find = findWithHandler warnOnError + where warnOnError path err = + hPutStrLn stderr (path ++ ": " ++ show err) >> return [] + +foldWithHandler :: (FilePath -> a -> E.Exception -> IO a) + -> RecursionPredicate + -> (a -> FindClause a) + -> a + -> FilePath + -> IO a + +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 return (evalFI (f state) path depth st) + traverse state dir depth dirSt = E.handle (errHandler dir state) $ + getDirContents dir >>= + flip foldM (evalFI (f state) dir depth dirSt) (\state name -> + E.handle (errHandler dir state) $ + let path = dir name + in F.getSymbolicLinkStatus path >>= visit state path depth) + +fold :: RecursionPredicate + -> (a -> FindClause a) + -> a + -> FilePath + -> IO a + +fold = foldWithHandler warnOnError + where warnOnError path a err = + hPutStrLn stderr (path ++ ": " ++ show err) >> return a + +always :: FindClause Bool +always = return True + +extension :: FindClause FilePath +extension = takeExtension `liftM` filePath + +fileName :: FindClause FilePath +fileName = takeFileName `liftM` filePath + +directory :: FindClause FilePath +directory = takeDirectory `liftM` filePath + +linkTarget :: FindClause (Maybe FilePath) +linkTarget = do + path <- filePath + st <- fileStatus + return $ if F.isSymbolicLink st + then unsafePerformIO $ E.handle (const (return Nothing)) + (Just `liftM` F.readSymbolicLink path) + else Nothing + +data FileType = BlockDevice + | CharacterDevice + | NamedPipe + | RegularFile + | Directory + | SymbolicLink + | Socket + | Unknown + deriving (Eq, Ord, Show) + +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 + +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 + +filePerms :: FindClause T.FileMode +filePerms = (.&. 0777) `liftM` fileMode + +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 + +liftOp :: Monad m => (a -> b -> c) -> m a -> b -> m c + +liftOp f a b = a >>= \a' -> return (f a' b) + +(~?) :: FindClause FilePath + -> G.GlobPattern + -> FindClause Bool + +(~?) = liftOp G.match + +infix 4 ~? + +(/~?) :: FindClause FilePath + -> G.GlobPattern + -> FindClause Bool +(/~?) = liftOp (\s p -> not (s `G.match` p)) + +infix 4 /~? + +(==?) :: Eq a => FindClause a + -> a + -> FindClause Bool + +(==?) = liftOp (==) + +infix 4 ==? + +(/=?) :: Eq a => FindClause a + -> a + -> FindClause Bool + +(/=?) = liftOp (/=) + +infix 4 /=? + +(>?) :: Ord a => FindClause a + -> a + -> FindClause Bool + +(>?) = liftOp (>) + +infix 4 >? + +( FindClause a + -> a + -> FindClause Bool + +( FindClause a + -> a + -> FindClause a + +(.&.?) = liftOp (.&.) + +infixl 7 .&.? + +(>=?) :: Ord a => FindClause a + -> a + -> FindClause Bool + +(>=?) = liftOp (>=) + +infix 4 >=? + +(<=?) :: Ord a => FindClause a + -> a + -> FindClause Bool + +(<=?) = liftOp (<=) + +infix 4 <=? + +(&&?) :: FindClause Bool + -> FindClause Bool + -> FindClause Bool + +(&&?) = liftM2 (&&) + +infixr 3 &&? + +(||?) :: FindClause Bool + -> FindClause Bool + -> FindClause Bool + +(||?) = liftM2 (||) + +infixr 2 ||? diff --git a/System/FilePath/Glob.hs b/System/FilePath/Glob.hs new file mode 100644 index 0000000..b09cdb1 --- /dev/null +++ b/System/FilePath/Glob.hs @@ -0,0 +1,137 @@ +module System.FilePath.Glob ( + GlobPattern + , match + ) where + +import Control.Arrow (second) +import Data.Ix (Ix, inRange) +import Data.List (nub) +import Data.Maybe (isJust) +import System.FilePath (pathSeparator) + +type GlobPattern = String + +spanClass :: Char -> String -> (String, String) + +spanClass c = gs [] + where gs _ [] = error "unterminated character class" + gs acc (d:ds) | d == c = (reverse acc, ds) + | d == '\\' = case ds of + (e:es) -> gs (e:'\\':acc) es + _ -> error "unterminated escape" + | otherwise = gs (d:acc) ds + +type CharRange = (Char, Char) + +data Ix a => SRange a = SRange [a] [(a, a)] + deriving (Show) + +inSRange :: Ix a => a -> SRange a -> Bool + +inSRange c (SRange d s) = c `elem` d || any (flip inRange c) s + +type CharClass = SRange Char + +makeClass :: String -> CharClass + +makeClass = makeClass' [] [] + where makeClass' :: [(Char, Char)] -> [Char] -> String -> CharClass + makeClass' dense sparse [] = SRange sparse dense + makeClass' dense sparse (a:'-':b:cs) = + makeClass' ((a,b):dense) sparse cs + makeClass' dense sparse (c:cs) = makeClass' dense (c:sparse) cs + +data MatchTerm = MatchLiteral String + | MatchAny + | MatchDir + | MatchChar + | MatchClass Bool CharClass + | MatchGroup [String] + deriving (Show) + +parseGlob :: GlobPattern -> [MatchTerm] + +parseGlob [] = [] +parseGlob ('*':'*':cs) = MatchAny : parseGlob cs +parseGlob ('*':cs) = MatchDir : parseGlob cs +parseGlob ('?':cs) = MatchChar : parseGlob cs +parseGlob ('[':cs) = let (cc, ccs) = spanClass ']' cs + cls = case cc of + ('!':ccs) -> MatchClass False $ makeClass ccs + _ -> MatchClass True $ makeClass cc + in cls : parseGlob ccs +parseGlob ('(':cs) = let (gg, ggs) = spanClass ')' cs + in MatchGroup (breakGroup [] gg) : parseGlob ggs + where breakGroup :: String -> String -> [String] + breakGroup acc [] = [reverse acc] + breakGroup _ ['\\'] = error "group: unterminated escape" + breakGroup acc ('\\':c:cs) = breakGroup (c:acc) cs + breakGroup acc ('|':cs) = reverse acc : breakGroup [] cs + breakGroup acc (c:cs) = breakGroup (c:acc) cs +parseGlob ['\\'] = error "glob: unterminated escape" +parseGlob ('\\':c:cs) = MatchLiteral [c] : parseGlob cs +parseGlob (c:cs) = MatchLiteral [c] : parseGlob cs + +simplifyTerms :: [MatchTerm] -> [MatchTerm] +simplifyTerms [] = [] +simplifyTerms (MatchLiteral []:as) = simplifyTerms as +simplifyTerms (m@(MatchLiteral a):as) = + case simplifyTerms as of + (MatchLiteral b:bs) -> MatchLiteral (a ++ b) : bs + bs -> m : bs +simplifyTerms (MatchClass True (SRange [] []):as) = simplifyTerms as +simplifyTerms (MatchClass True (SRange a@[_] []):as) = + simplifyTerms $ MatchLiteral a : as +simplifyTerms (MatchGroup []:as) = simplifyTerms as +simplifyTerms (MatchGroup gs:as) = + case commonPrefix gs of + (p,[]) -> simplifyTerms (MatchLiteral p : as) + (p,ss) -> simplifyTerms (MatchLiteral p : MatchGroup ss : as) +simplifyTerms (a:as) = a:simplifyTerms as + +commonPrefix :: [String] -> (String, [String]) +commonPrefix = second nub . pfx "" + where pfx _ [] = ("", []) + pfx acc ss | any null ss = (reverse acc, ss) + | otherwise = let hs = map head ss + h = head hs + in if all (h==) $ tail hs + then pfx (h:acc) $ map tail ss + else (reverse acc, ss) + +matchTerms :: [MatchTerm] -> String -> Maybe () + +matchTerms [] [] = return () +matchTerms [] _ = fail "residual string" +matchTerms (MatchLiteral m:ts) cs = matchLiteral m cs >>= matchTerms ts + where matchLiteral (a:as) (b:bs) | a == b = matchLiteral as bs + matchLiteral [] as = return as + matchLiteral _ _ = fail "not a prefix" +matchTerms (MatchClass k c:ts) cs = matchClass cs >>= matchTerms ts + where matchClass (b:bs) | (inClass && k) || not (inClass || k) = return bs + where inClass = b `inSRange` c + matchClass _ = fail "no match" +matchTerms (MatchGroup g:ts) cs = matchGroup g cs >>= matchTerms ts + where matchGroup g as | any null g = return as + matchGroup g (a:as) | a `elem` map head g = + matchGroup (map tail g) as + matchGroup _ _ = fail "not in group" +matchTerms [MatchAny] _ = return () +matchTerms (MatchAny:ts) cs = matchAny cs >>= matchTerms ts + where matchAny [] = fail "no match" + matchAny cs = case matchTerms ts cs of + Nothing -> matchAny (tail cs) + _ -> return cs +matchTerms [MatchDir] cs | pathSeparator `elem` cs = fail "path separator" + | otherwise = return () +matchTerms (MatchDir:ts) cs = matchDir cs >>= matchTerms ts + where matchDir [] = fail "no match" + matchDir (c:_) | c == pathSeparator = fail "path separator" + matchDir cs = case matchTerms ts cs of + Nothing -> matchDir $ tail cs + _ -> return cs + +match :: GlobPattern -> FilePath -> Bool + +match pat name = let terms = simplifyTerms (parseGlob pat) + in (isJust . matchTerms terms) name From c7a595006f6bf7298dd105e4015cf2188a4d74cb Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 07:07:46 +0000 Subject: [PATCH 03/67] Turn on warnings; add mtl dependency. --HG-- extra : convert_revision : aa0db6a7b7ca0964459848531fec1df2c7c99ade --- FileManip.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/FileManip.cabal b/FileManip.cabal index e5b38d8..497b7ca 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -8,7 +8,8 @@ Category: System Description: A Haskell library for working with files and directories. Includes modules for pattern matching, finding files, and more. -Build-Depends: base, filepath, unix +Build-Depends: base, filepath, mtl, unix +GHC-Options: -Wall Exposed-Modules: System.FilePath.Find, System.FilePath.Glob From 791977cd5c917608abf395c9b08e1f5d2fe7ac4c Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 07:08:57 +0000 Subject: [PATCH 04/67] Export more functions. --HG-- extra : convert_revision : c26159bf75acec5dac52dfffbc54b786ec304d54 --- System/FilePath/Find.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index e612180..d757663 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -36,6 +36,8 @@ module System.FilePath.Find ( , modificationTime , statusChangeTime + , linkTarget + , (~?) , (/~?) , (==?) @@ -46,6 +48,8 @@ module System.FilePath.Find ( , (<=?) , (&&?) , (||?) + + , (.&.?) ) where import qualified Control.Exception as E From 4a365311e6fa1276f6dd53e217e3458e35087d3c Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 07:29:32 +0000 Subject: [PATCH 05/67] Working snapshot. --HG-- extra : convert_revision : 49a538240310e9c819a2ad33fc4589ca824a8c3f --- System/FilePath/Find.hs | 34 ++++++++++++++++++---------------- System/FilePath/Glob.hs | 41 +++++++++++++++++++++++------------------ 2 files changed, 41 insertions(+), 34 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index d757663..19e4d6a 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -38,7 +38,7 @@ module System.FilePath.Find ( , linkTarget - , (~?) + , (~~?) , (/~?) , (==?) , (/=?) @@ -52,7 +52,6 @@ module System.FilePath.Find ( , (.&.?) ) where -import qualified Control.Exception as E import Control.Monad (foldM, forM, liftM, liftM2) import Control.Monad.Fix (MonadFix) import Control.Monad.State (State(..), evalState) @@ -60,11 +59,12 @@ import Data.Bits (Bits, (.&.)) import Data.List (sort) import System.Directory (getDirectoryContents) import System.FilePath ((), takeDirectory, takeExtension, takeFileName) -import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) +import System.FilePath.Glob (GlobPattern, (~~), (/~)) import System.IO (hPutStrLn, stderr) +import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) +import qualified Control.Exception as E import qualified System.Posix.Files as F import qualified System.Posix.Types as T -import qualified System.FilePath.Glob as G type Info = (FilePath, Int, F.FileStatus) @@ -79,20 +79,22 @@ evalFI :: FindClause a evalFI m p d s = evalState (runFI m) (p, d, s) +mkFI :: (Info -> (a, Info)) -> FindClause a + mkFI = FI . State filePath :: FindClause FilePath filePath = mkFI $ \st@(p, _, _) -> (p, st) -fileStatus :: FindClause F.FileStatus - -fileStatus = mkFI $ \st@(_, _, s) -> (s, st) - depth :: FindClause Int depth = mkFI $ \st@(_, d, _) -> (d, st) +fileStatus :: FindClause F.FileStatus + +fileStatus = mkFI $ \st@(_, _, s) -> (s, st) + type FilterPredicate = FindClause Bool type RecursionPredicate = FindClause Bool @@ -254,18 +256,18 @@ liftOp :: Monad m => (a -> b -> c) -> m a -> b -> m c liftOp f a b = a >>= \a' -> return (f a' b) -(~?) :: FindClause FilePath - -> G.GlobPattern - -> FindClause Bool +(~~?) :: FindClause FilePath + -> GlobPattern + -> FindClause Bool -(~?) = liftOp G.match +(~~?) = liftOp (~~) -infix 4 ~? +infix 4 ~~? (/~?) :: FindClause FilePath - -> G.GlobPattern - -> FindClause Bool -(/~?) = liftOp (\s p -> not (s `G.match` p)) + -> GlobPattern + -> FindClause Bool +(/~?) = liftOp (/~) infix 4 /~? diff --git a/System/FilePath/Glob.hs b/System/FilePath/Glob.hs index b09cdb1..a707956 100644 --- a/System/FilePath/Glob.hs +++ b/System/FilePath/Glob.hs @@ -1,6 +1,7 @@ module System.FilePath.Glob ( GlobPattern - , match + , (~~) + , (/~) ) where import Control.Arrow (second) @@ -21,8 +22,6 @@ spanClass c = gs [] _ -> error "unterminated escape" | otherwise = gs (d:acc) ds -type CharRange = (Char, Char) - data Ix a => SRange a = SRange [a] [(a, a)] deriving (Show) @@ -57,7 +56,7 @@ parseGlob ('*':cs) = MatchDir : parseGlob cs parseGlob ('?':cs) = MatchChar : parseGlob cs parseGlob ('[':cs) = let (cc, ccs) = spanClass ']' cs cls = case cc of - ('!':ccs) -> MatchClass False $ makeClass ccs + ('!':ccs') -> MatchClass False $ makeClass ccs' _ -> MatchClass True $ makeClass cc in cls : parseGlob ccs parseGlob ('(':cs) = let (gg, ggs) = spanClass ')' cs @@ -65,9 +64,9 @@ parseGlob ('(':cs) = let (gg, ggs) = spanClass ')' cs where breakGroup :: String -> String -> [String] breakGroup acc [] = [reverse acc] breakGroup _ ['\\'] = error "group: unterminated escape" - breakGroup acc ('\\':c:cs) = breakGroup (c:acc) cs - breakGroup acc ('|':cs) = reverse acc : breakGroup [] cs - breakGroup acc (c:cs) = breakGroup (c:acc) cs + breakGroup acc ('\\':c:cs') = breakGroup (c:acc) cs' + breakGroup acc ('|':cs') = reverse acc : breakGroup [] cs' + breakGroup acc (c:cs') = breakGroup (c:acc) cs' parseGlob ['\\'] = error "glob: unterminated escape" parseGlob ('\\':c:cs) = MatchLiteral [c] : parseGlob cs parseGlob (c:cs) = MatchLiteral [c] : parseGlob cs @@ -112,26 +111,32 @@ matchTerms (MatchClass k c:ts) cs = matchClass cs >>= matchTerms ts where inClass = b `inSRange` c matchClass _ = fail "no match" matchTerms (MatchGroup g:ts) cs = matchGroup g cs >>= matchTerms ts - where matchGroup g as | any null g = return as - matchGroup g (a:as) | a `elem` map head g = - matchGroup (map tail g) as + where matchGroup g' as | any null g' = return as + matchGroup g' (a:as) | a `elem` map head g' = + matchGroup (map tail g') as matchGroup _ _ = fail "not in group" matchTerms [MatchAny] _ = return () matchTerms (MatchAny:ts) cs = matchAny cs >>= matchTerms ts where matchAny [] = fail "no match" - matchAny cs = case matchTerms ts cs of - Nothing -> matchAny (tail cs) + matchAny cs' = case matchTerms ts cs' of + Nothing -> matchAny (tail cs') _ -> return cs matchTerms [MatchDir] cs | pathSeparator `elem` cs = fail "path separator" | otherwise = return () matchTerms (MatchDir:ts) cs = matchDir cs >>= matchTerms ts where matchDir [] = fail "no match" matchDir (c:_) | c == pathSeparator = fail "path separator" - matchDir cs = case matchTerms ts cs of - Nothing -> matchDir $ tail cs - _ -> return cs + matchDir cs' = case matchTerms ts cs' of + Nothing -> matchDir $ tail cs' + _ -> return cs' +matchTerms (MatchChar:_) [] = fail "end of input" +matchTerms (MatchChar:ts) (_:cs) = matchTerms ts cs -match :: GlobPattern -> FilePath -> Bool +(~~) :: FilePath -> GlobPattern -> Bool -match pat name = let terms = simplifyTerms (parseGlob pat) - in (isJust . matchTerms terms) name +name ~~ pat = let terms = simplifyTerms (parseGlob pat) + in (isJust . matchTerms terms) name + +(/~) :: FilePath -> GlobPattern -> Bool + +(/~) = (not . ) . (~~) From a5675ac0145cd938219db224387b0234c29c0bb0 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 16:53:55 +0000 Subject: [PATCH 06/67] Fix the type signature of fold, and clean up other names. --HG-- extra : convert_revision : 33c7ae5ca3ffad927894cb36d4ba4fc4729c76f2 --- System/FilePath/Find.hs | 41 ++++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 19e4d6a..6195c2d 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -1,7 +1,8 @@ {-# OPTIONS_GHC -fglasgow-exts #-} module System.FilePath.Find ( - FileType(..) + FileInfo(..) + , FileType(..) , FindClause , FilterPredicate , RecursionPredicate @@ -15,6 +16,7 @@ module System.FilePath.Find ( , filePath , fileStatus , depth + , fileInfo , always , extension @@ -66,9 +68,18 @@ import qualified Control.Exception as E import qualified System.Posix.Files as F import qualified System.Posix.Types as T -type Info = (FilePath, Int, F.FileStatus) +data FileInfo = FileInfo + { + infoPath :: FilePath + , infoDepth :: Int + , infoStatus :: F.FileStatus + } -newtype FindClause a = FI { runFI :: State Info a } +mkFI :: FilePath -> Int -> F.FileStatus -> FileInfo + +mkFI = FileInfo + +newtype FindClause a = FI { runFI :: State FileInfo a } deriving (Functor, Monad, MonadFix) evalFI :: FindClause a @@ -77,23 +88,27 @@ evalFI :: FindClause a -> F.FileStatus -> a -evalFI m p d s = evalState (runFI m) (p, d, s) +evalFI m p d s = evalState (runFI m) (mkFI p d s) -mkFI :: (Info -> (a, Info)) -> FindClause a +mkFindClause :: (FileInfo -> (a, FileInfo)) -> FindClause a -mkFI = FI . State +mkFindClause = FI . State + +fileInfo :: FindClause FileInfo + +fileInfo = mkFindClause $ \st -> (st, st) filePath :: FindClause FilePath -filePath = mkFI $ \st@(p, _, _) -> (p, st) +filePath = infoPath `liftM` fileInfo depth :: FindClause Int -depth = mkFI $ \st@(_, d, _) -> (d, st) +depth = infoDepth `liftM` fileInfo fileStatus :: FindClause F.FileStatus -fileStatus = mkFI $ \st@(_, _, s) -> (s, st) +fileStatus = infoStatus `liftM` fileInfo type FilterPredicate = FindClause Bool type RecursionPredicate = FindClause Bool @@ -140,7 +155,7 @@ find = findWithHandler warnOnError foldWithHandler :: (FilePath -> a -> E.Exception -> IO a) -> RecursionPredicate - -> (a -> FindClause a) + -> (a -> FileInfo -> a) -> a -> FilePath -> IO a @@ -151,16 +166,16 @@ foldWithHandler errHandler recurse f state path = where visit state path depth st = if F.isDirectory st && evalFI recurse path depth st then traverse state path (succ depth) st - else return (evalFI (f state) path depth st) + else return (f state (mkFI path depth st)) traverse state dir depth dirSt = E.handle (errHandler dir state) $ getDirContents dir >>= - flip foldM (evalFI (f state) dir depth dirSt) (\state name -> + flip foldM (f state (mkFI dir depth dirSt)) (\state name -> E.handle (errHandler dir state) $ let path = dir name in F.getSymbolicLinkStatus path >>= visit state path depth) fold :: RecursionPredicate - -> (a -> FindClause a) + -> (a -> FileInfo -> a) -> a -> FilePath -> IO a From 9e5996a5a7bf7db26e7f8dfb539c3b3f033cc4bf Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 17:06:48 +0000 Subject: [PATCH 07/67] Rename Glob -> GlobPattern. --HG-- extra : convert_revision : 8d1646ccad02799799ef66d72684d9d110f01654 --- FileManip.cabal | 2 +- System/FilePath/Find.hs | 2 +- System/FilePath/{Glob.hs => GlobPattern.hs} | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) rename System/FilePath/{Glob.hs => GlobPattern.hs} (99%) diff --git a/FileManip.cabal b/FileManip.cabal index 497b7ca..407be2a 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -12,4 +12,4 @@ Build-Depends: base, filepath, mtl, unix GHC-Options: -Wall Exposed-Modules: System.FilePath.Find, - System.FilePath.Glob + System.FilePath.GlobPattern diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 6195c2d..8ebe239 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -61,7 +61,7 @@ import Data.Bits (Bits, (.&.)) import Data.List (sort) import System.Directory (getDirectoryContents) import System.FilePath ((), takeDirectory, takeExtension, takeFileName) -import System.FilePath.Glob (GlobPattern, (~~), (/~)) +import System.FilePath.GlobPattern (GlobPattern, (~~), (/~)) import System.IO (hPutStrLn, stderr) import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) import qualified Control.Exception as E diff --git a/System/FilePath/Glob.hs b/System/FilePath/GlobPattern.hs similarity index 99% rename from System/FilePath/Glob.hs rename to System/FilePath/GlobPattern.hs index a707956..56babc4 100644 --- a/System/FilePath/Glob.hs +++ b/System/FilePath/GlobPattern.hs @@ -1,4 +1,4 @@ -module System.FilePath.Glob ( +module System.FilePath.GlobPattern ( GlobPattern , (~~) , (/~) From ec2fcb2c4a80dc50cf57e4044eab6b8c1dcabffe Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 19:46:06 +0000 Subject: [PATCH 08/67] Add Manip module. --HG-- extra : convert_revision : 38d40de52e0b82b618bdaa0bffe08d89ff60d830 --- FileManip.cabal | 3 ++- System/FilePath/Manip.hs | 49 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+), 1 deletion(-) create mode 100644 System/FilePath/Manip.hs diff --git a/FileManip.cabal b/FileManip.cabal index 407be2a..9904cd9 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -12,4 +12,5 @@ Build-Depends: base, filepath, mtl, unix GHC-Options: -Wall Exposed-Modules: System.FilePath.Find, - System.FilePath.GlobPattern + System.FilePath.GlobPattern, + System.FilePath.Manip diff --git a/System/FilePath/Manip.hs b/System/FilePath/Manip.hs new file mode 100644 index 0000000..0883be2 --- /dev/null +++ b/System/FilePath/Manip.hs @@ -0,0 +1,49 @@ +module System.FilePath.Manip ( + renameWith + , modifyWith + , modifyWithBackup + , modifyInPlace + ) where + +import Control.Exception (bracket, bracket_, handle, throwIO) +import Control.Monad (liftM) +import Data.Bits ((.&.)) +import System.Directory (removeFile) +import System.IO (IOMode(..), hClose, openFile) +import System.Posix.Files (fileMode, getFileStatus, rename, setFileMode) +import System.Posix.Temp (mkstemp) +import qualified Data.ByteString.Lazy.Char8 as L + +renameWith :: (FilePath -> FilePath) -> FilePath -> IO () + +renameWith f path = rename path (f path) + +modifyWith :: (FilePath -> FilePath -> IO ()) + -> (L.ByteString -> L.ByteString) + -> FilePath + -> IO () + +modifyWith after transform path = + bracket (openFile path ReadMode) hClose $ \ih -> do + (tmpPath, oh) <- mkstemp (path ++ "XXXXXX") + let ignore = return () + nukeTmp = handle (const ignore) (removeFile tmpPath) + handle (\e -> nukeTmp >> throwIO e) $ do + bracket_ ignore (hClose oh) $ + transform `liftM` L.hGetContents ih >>= L.hPut oh + handle (const nukeTmp) $ do + mode <- fileMode `liftM` getFileStatus path + setFileMode tmpPath (mode .&. 0777) + after path tmpPath + +modifyInPlace :: (L.ByteString -> L.ByteString) -> FilePath -> IO () + +modifyInPlace = modifyWith (flip rename) + +modifyWithBackup :: (FilePath -> FilePath) + -> (L.ByteString -> L.ByteString) + -> FilePath + -> IO () + +modifyWithBackup f = modifyWith backup + where backup path tmpPath = renameWith f path >> rename tmpPath path From c5ccd0a6ab0a87359b6adf87fbda2faf50d57554 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 20:11:13 +0000 Subject: [PATCH 09/67] Parameterise modifyWith. --HG-- extra : convert_revision : 719d7cb72f1ba1a11228a2ee65a41f47a2d04de7 --- System/FilePath/Manip.hs | 55 ++++++++++++++++++++++++++-------------- 1 file changed, 36 insertions(+), 19 deletions(-) diff --git a/System/FilePath/Manip.hs b/System/FilePath/Manip.hs index 0883be2..f1cfc59 100644 --- a/System/FilePath/Manip.hs +++ b/System/FilePath/Manip.hs @@ -1,5 +1,8 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} + module System.FilePath.Manip ( - renameWith + Modifiable(..) + , renameWith , modifyWith , modifyWithBackup , modifyInPlace @@ -9,19 +12,45 @@ import Control.Exception (bracket, bracket_, handle, throwIO) import Control.Monad (liftM) import Data.Bits ((.&.)) import System.Directory (removeFile) -import System.IO (IOMode(..), hClose, openFile) +import System.IO (Handle, IOMode(..), hClose, hGetContents, hPutStr, openFile) import System.Posix.Files (fileMode, getFileStatus, rename, setFileMode) import System.Posix.Temp (mkstemp) +import Data.ByteString.Base (ByteString, LazyByteString) +import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L renameWith :: (FilePath -> FilePath) -> FilePath -> IO () renameWith f path = rename path (f path) -modifyWith :: (FilePath -> FilePath -> IO ()) - -> (L.ByteString -> L.ByteString) - -> FilePath - -> IO () +class Modifiable a where + pipeline :: (a -> a) -> Handle -> Handle -> IO () + +instance Modifiable ByteString where + pipeline f ih oh = B.hGetContents ih >>= return . f >>= B.hPut oh + +instance Modifiable LazyByteString where + pipeline f ih oh = L.hGetContents ih >>= return . f >>= L.hPut oh + +instance Modifiable String where + pipeline f ih oh = hGetContents ih >>= return . f >>= hPutStr oh + +modifyInPlace :: Modifiable a => (a -> a) -> FilePath -> IO () + +modifyInPlace = modifyWith (flip rename) + +modifyWithBackup :: Modifiable a => (FilePath -> FilePath) + -> (a -> a) + -> FilePath + -> IO () + +modifyWithBackup f = modifyWith backup + where backup path tmpPath = renameWith f path >> rename tmpPath path + +modifyWith :: Modifiable a => (FilePath -> FilePath -> IO ()) + -> (a -> a) + -> FilePath + -> IO () modifyWith after transform path = bracket (openFile path ReadMode) hClose $ \ih -> do @@ -30,20 +59,8 @@ modifyWith after transform path = nukeTmp = handle (const ignore) (removeFile tmpPath) handle (\e -> nukeTmp >> throwIO e) $ do bracket_ ignore (hClose oh) $ - transform `liftM` L.hGetContents ih >>= L.hPut oh + pipeline transform ih oh handle (const nukeTmp) $ do mode <- fileMode `liftM` getFileStatus path setFileMode tmpPath (mode .&. 0777) after path tmpPath - -modifyInPlace :: (L.ByteString -> L.ByteString) -> FilePath -> IO () - -modifyInPlace = modifyWith (flip rename) - -modifyWithBackup :: (FilePath -> FilePath) - -> (L.ByteString -> L.ByteString) - -> FilePath - -> IO () - -modifyWithBackup f = modifyWith backup - where backup path tmpPath = renameWith f path >> rename tmpPath path From 1f5a65b56eda3e0c4d6b9a5fe5db609bd291e117 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 22:53:13 +0000 Subject: [PATCH 10/67] Follow links a bit more usefully. --HG-- extra : convert_revision : 71391f687787d19d094c467eeded471042f4311a --- System/FilePath/Find.hs | 31 +++++++++++++++++++++++-------- 1 file changed, 23 insertions(+), 8 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 8ebe239..623d619 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -38,7 +38,8 @@ module System.FilePath.Find ( , modificationTime , statusChangeTime - , linkTarget + , readLink + , followStatus , (~~?) , (/~?) @@ -60,7 +61,8 @@ import Control.Monad.State (State(..), evalState) import Data.Bits (Bits, (.&.)) import Data.List (sort) import System.Directory (getDirectoryContents) -import System.FilePath ((), takeDirectory, takeExtension, takeFileName) +import System.FilePath ((), replaceFileName, takeDirectory, takeExtension, + takeFileName) import System.FilePath.GlobPattern (GlobPattern, (~~), (/~)) import System.IO (hPutStrLn, stderr) import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) @@ -73,7 +75,11 @@ data FileInfo = FileInfo infoPath :: FilePath , infoDepth :: Int , infoStatus :: F.FileStatus - } + } deriving (Eq) + +instance Eq F.FileStatus where + a == b = F.deviceID a == F.deviceID b && + F.fileID a == F.fileID b mkFI :: FilePath -> Int -> F.FileStatus -> FileInfo @@ -196,14 +202,23 @@ fileName = takeFileName `liftM` filePath directory :: FindClause FilePath directory = takeDirectory `liftM` filePath -linkTarget :: FindClause (Maybe FilePath) -linkTarget = do +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.readSymbolicLink path) - else Nothing + then unsafePerformIO $ E.handle (const (return Nothing)) $ + Just `liftM` f path + else Nothing + +readLink :: FindClause (Maybe FilePath) + +readLink = withLink F.readSymbolicLink + +followStatus :: FindClause (Maybe F.FileStatus) + +followStatus = withLink F.getFileStatus data FileType = BlockDevice | CharacterDevice From 5722b8014042dbc11c0aabb96915e361b4e67e2b Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 22:53:33 +0000 Subject: [PATCH 11/67] Simple examples. --HG-- extra : convert_revision : 3fc23f5e8d6a5372a4db3192751746e71b365cf9 --- examples/Simple.hs | 70 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100644 examples/Simple.hs diff --git a/examples/Simple.hs b/examples/Simple.hs new file mode 100644 index 0000000..c115693 --- /dev/null +++ b/examples/Simple.hs @@ -0,0 +1,70 @@ +import Control.Monad +import qualified Data.ByteString.Char8 as S +import System.FilePath +import System.FilePath.Find +import System.FilePath.Manip +import Text.Regex.Posix ((=~)) + + + +-- Get a list of all symlinks. + +getDanglingLinks :: FilePath -> IO [FilePath] + +getDanglingLinks = find always (fileType ==? SymbolicLink &&? + followStatus ==? Nothing) + + + +-- Rename all ".cpp" files to ".C". + +renameCppToC :: FilePath -> IO () + +renameCppToC path = find always (extension ==? ".cpp") path >>= + mapM_ (renameWith (replaceExtension ".C")) + + + +-- A recursion control predicate that will avoid recursing into +-- directories commonly used by revision control tools. + +noRCS :: RecursionPredicate + +noRCS = (`elem` ["_darcs","SCCS","CVS",".svn",".hg",".git"]) `liftM` fileName + +cSources :: FilePath -> IO [FilePath] + +cSources = find noRCS (extension ==? ".c" ||? extension ==? ".h") + + + +-- Replace all uses of "monkey" with "simian", saving the original copy +-- of the file with a ".bak" extension: + +monkeyAround :: FilePath -> IO () + +monkeyAround = modifyWithBackup (<.> "bak") (unwords . map reMonkey . words) + where reMonkey x = if x == "monkey" then "simian" else x + + + +-- Given a simple grep, it's easy to construct a recursive grep. + +grep :: (Int -> S.ByteString -> a) -> String -> S.ByteString -> [a] + +grep f pat s = consider 0 (S.lines s) + where consider _ [] = [] + consider n (l:ls) | S.null l = consider (n+1) ls + consider n (l:ls) | l =~ pat = (f n l):ls' + | otherwise = ls' + where ls' = consider (n+1) ls + +grepFile :: (Int -> S.ByteString -> a) -> String -> FilePath -> IO [a] + +grepFile f pat name = grep f pat `liftM` S.readFile name + +recGrep :: String -> FilePath -> IO [(FilePath, Int, S.ByteString)] + +recGrep pat top = find always (fileType ==? RegularFile) top >>= + mapM ((,,) >>= flip grepFile pat) >>= + return . concat From 4475f313c4c56655f2a56b041e49c87556c1a9c6 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 23:07:37 +0000 Subject: [PATCH 12/67] Reduce verbosity. --HG-- extra : convert_revision : 06b22ff40f49bb6251adae2c8beed8a757ae84e0 --- System/FilePath/Find.hs | 65 +++++++---------------------------------- 1 file changed, 11 insertions(+), 54 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 623d619..670c794 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -286,89 +286,46 @@ liftOp :: Monad m => (a -> b -> c) -> m a -> b -> m c liftOp f a b = a >>= \a' -> return (f a' b) -(~~?) :: FindClause FilePath - -> GlobPattern - -> FindClause Bool - +(~~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool (~~?) = liftOp (~~) - infix 4 ~~? -(/~?) :: FindClause FilePath - -> GlobPattern - -> FindClause Bool +(/~?) :: FindClause FilePath -> GlobPattern -> FindClause Bool (/~?) = liftOp (/~) - infix 4 /~? -(==?) :: Eq a => FindClause a - -> a - -> FindClause Bool - +(==?) :: Eq a => FindClause a -> a -> FindClause Bool (==?) = liftOp (==) - infix 4 ==? -(/=?) :: Eq a => FindClause a - -> a - -> FindClause Bool - +(/=?) :: Eq a => FindClause a -> a -> FindClause Bool (/=?) = liftOp (/=) - infix 4 /=? -(>?) :: Ord a => FindClause a - -> a - -> FindClause Bool - +(>?) :: Ord a => FindClause a -> a -> FindClause Bool (>?) = liftOp (>) - infix 4 >? -( FindClause a - -> a - -> FindClause Bool - +( FindClause a -> a -> FindClause Bool ( FindClause a - -> a - -> FindClause a - +(.&.?) :: Bits a => FindClause a -> a -> FindClause a (.&.?) = liftOp (.&.) - infixl 7 .&.? -(>=?) :: Ord a => FindClause a - -> a - -> FindClause Bool - +(>=?) :: Ord a => FindClause a -> a -> FindClause Bool (>=?) = liftOp (>=) - infix 4 >=? -(<=?) :: Ord a => FindClause a - -> a - -> FindClause Bool - +(<=?) :: Ord a => FindClause a -> a -> FindClause Bool (<=?) = liftOp (<=) - infix 4 <=? -(&&?) :: FindClause Bool - -> FindClause Bool - -> FindClause Bool - +(&&?) :: FindClause Bool -> FindClause Bool -> FindClause Bool (&&?) = liftM2 (&&) - infixr 3 &&? -(||?) :: FindClause Bool - -> FindClause Bool - -> FindClause Bool - +(||?) :: FindClause Bool -> FindClause Bool -> FindClause Bool (||?) = liftM2 (||) - infixr 2 ||? From ee72746a9238cac940375cf3e6deb988db7a53a2 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 30 Apr 2007 23:07:44 +0000 Subject: [PATCH 13/67] Tidy. --HG-- extra : convert_revision : 2c20dd4c3f44ab869278b5f4a4b584a7192cf6af --- examples/Simple.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Simple.hs b/examples/Simple.hs index c115693..0370ef7 100644 --- a/examples/Simple.hs +++ b/examples/Simple.hs @@ -21,7 +21,7 @@ getDanglingLinks = find always (fileType ==? SymbolicLink &&? renameCppToC :: FilePath -> IO () renameCppToC path = find always (extension ==? ".cpp") path >>= - mapM_ (renameWith (replaceExtension ".C")) + mapM_ (renameWith (replaceExtension ".C")) From 7e249fd3d2b996b78bd6443a44efbeda83ada68d Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Tue, 1 May 2007 05:49:58 +0000 Subject: [PATCH 14/67] Add minimal docs. --HG-- extra : convert_revision : 538c7f076e7f4f4fcce1632f482050a9e208214c --- System/FilePath/Find.hs | 20 ++++++++- System/FilePath/Manip.hs | 87 +++++++++++++++++++++++++++++++--------- 2 files changed, 85 insertions(+), 22 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 670c794..8587d20 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -1,4 +1,12 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | +-- Module: System.FilePath.Find +-- Copyright: Bryan O'Sullivan +-- License: LGPL +-- Maintainer: Bryan O'Sullivan +-- Stability: unstable +-- Portability: Unix-like systems (requires newtype deriving) module System.FilePath.Find ( FileInfo(..) @@ -69,6 +77,7 @@ import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) import qualified Control.Exception as E import qualified System.Posix.Files as F import qualified System.Posix.Types as T +import Debug.Trace data FileInfo = FileInfo { @@ -86,7 +95,7 @@ mkFI :: FilePath -> Int -> F.FileStatus -> FileInfo mkFI = FileInfo newtype FindClause a = FI { runFI :: State FileInfo a } - deriving (Functor, Monad, MonadFix) + deriving (Functor, Monad) evalFI :: FindClause a -> FilePath @@ -282,6 +291,13 @@ modificationTime = F.modificationTime `liftM` fileStatus statusChangeTime :: FindClause T.EpochTime statusChangeTime = F.statusChangeTime `liftM` fileStatus +contains :: FilePath -> FindClause Bool +contains p = do + d <- filePath + return $ unsafePerformIO $ + E.handle (const (return False)) $ + F.getFileStatus (d p) >> return True + liftOp :: Monad m => (a -> b -> c) -> m a -> b -> m c liftOp f a b = a >>= \a' -> return (f a' b) diff --git a/System/FilePath/Manip.hs b/System/FilePath/Manip.hs index f1cfc59..4b721a8 100644 --- a/System/FilePath/Manip.hs +++ b/System/FilePath/Manip.hs @@ -1,7 +1,15 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | +-- Module: System.FilePath.Manip +-- Copyright: Bryan O'Sullivan +-- License: LGPL +-- Maintainer: Bryan O'Sullivan +-- Stability: unstable +-- Portability: Unix-like systems (requires flexible instances) module System.FilePath.Manip ( - Modifiable(..) + Streamable(..) , renameWith , modifyWith , modifyWithBackup @@ -12,43 +20,82 @@ import Control.Exception (bracket, bracket_, handle, throwIO) import Control.Monad (liftM) import Data.Bits ((.&.)) import System.Directory (removeFile) -import System.IO (Handle, IOMode(..), hClose, hGetContents, hPutStr, openFile) +import System.IO (Handle, IOMode(..), hClose, openFile) import System.Posix.Files (fileMode, getFileStatus, rename, setFileMode) import System.Posix.Temp (mkstemp) -import Data.ByteString.Base (ByteString, LazyByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L +import qualified System.IO as I -renameWith :: (FilePath -> FilePath) -> FilePath -> IO () +-- | Use a renaming function to generate a new name for a file, then +-- rename it. +renameWith :: (FilePath -> FilePath) -- ^ function to rename with + -> FilePath -- ^ file to rename + -> IO () renameWith f path = rename path (f path) -class Modifiable a where - pipeline :: (a -> a) -> Handle -> Handle -> IO () +-- | Type class for string manipulation over files. +class Streamable a where + -- | Read the entire contents of a 'Handle'. + readAll :: Handle -> IO a + -- | Write an entire string to a 'Handle'. + writeAll :: Handle -> a -> IO () -instance Modifiable ByteString where - pipeline f ih oh = B.hGetContents ih >>= return . f >>= B.hPut oh +instance Streamable B.ByteString where + readAll = B.hGetContents + writeAll = B.hPut -instance Modifiable LazyByteString where - pipeline f ih oh = L.hGetContents ih >>= return . f >>= L.hPut oh +instance Streamable L.ByteString where + readAll = L.hGetContents + writeAll = L.hPut -instance Modifiable String where - pipeline f ih oh = hGetContents ih >>= return . f >>= hPutStr oh +instance Streamable String where + readAll = I.hGetContents + writeAll = I.hPutStr -modifyInPlace :: Modifiable a => (a -> a) -> FilePath -> IO () +-- | Modify a file in place using the given function. This is +-- performed by writing to a temporary file, then renaming it on top of +-- the existing file when done. +modifyInPlace :: Streamable a => (a -> a) -- ^ transformation function + -> FilePath -- ^ name of file to modify + -> IO () modifyInPlace = modifyWith (flip rename) -modifyWithBackup :: Modifiable a => (FilePath -> FilePath) - -> (a -> a) - -> FilePath +-- | Modify a file in place using the given function. The original +-- copy of the file is saved under a new name. This is performed by +-- writing to a temporary file; renaming the original file to its new +-- name; then renaming the temporary file to the original name. +-- +-- Example: +-- +-- @ +-- -- save original file with a \".bak\" extension +-- 'modifyWithBackup' (\<.\> \"bak\") +-- @ +modifyWithBackup :: Streamable a => + (FilePath -> FilePath) -- ^ chooses new name for original file + -> (a -> a) -- ^ transformation function + -> FilePath -- ^ name of file to modify -> IO () modifyWithBackup f = modifyWith backup where backup path tmpPath = renameWith f path >> rename tmpPath path -modifyWith :: Modifiable a => (FilePath -> FilePath -> IO ()) - -> (a -> a) +-- | Modify a file in place using the given function. The new content +-- is written to a temporary file. Once this is complete, the file +-- manipulation action is called. Its arguments are the names of the +-- original and temporary files. +-- +-- Example: +-- +-- @ +-- 'modifyInPlace' = 'modifyWith' (flip rename) +-- @ +modifyWith :: Streamable a => + (FilePath -> FilePath -> IO ()) -- ^ file manipulation action + -> (a -> a) -- ^ transformation function -> FilePath -> IO () @@ -59,7 +106,7 @@ modifyWith after transform path = nukeTmp = handle (const ignore) (removeFile tmpPath) handle (\e -> nukeTmp >> throwIO e) $ do bracket_ ignore (hClose oh) $ - pipeline transform ih oh + readAll ih >>= return . transform >>= writeAll oh handle (const nukeTmp) $ do mode <- fileMode `liftM` getFileStatus path setFileMode tmpPath (mode .&. 0777) From 85545ec0c34abc4d770f1fbf3e8dbd4eaca70bc8 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Tue, 1 May 2007 05:57:14 +0000 Subject: [PATCH 15/67] Point to license file. --HG-- extra : convert_revision : b60ca5b0fd568cb352b251ee4016f9882fce4b65 --- COPYING.LIB | 510 ++++++++++++++++++++++++++++++++++++++++++++++++ FileManip.cabal | 1 + 2 files changed, 511 insertions(+) create mode 100644 COPYING.LIB diff --git a/COPYING.LIB b/COPYING.LIB new file mode 100644 index 0000000..cf9b6b9 --- /dev/null +++ b/COPYING.LIB @@ -0,0 +1,510 @@ + + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations +below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. +^L + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it +becomes a de-facto standard. To achieve this, non-free programs must +be allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. +^L + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control +compilation and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. +^L + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. +^L + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at least + three years, to give the same user the materials specified in + Subsection 6a, above, for a charge no more than the cost of + performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. +^L + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. +^L + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply, and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License +may add an explicit geographical distribution limitation excluding those +countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. +^L + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS +^L + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms +of the ordinary General Public License). + + To apply these terms, attach the following notices to the library. +It is safest to attach them to the start of each source file to most +effectively convey the exclusion of warranty; and each file should +have at least the "copyright" line and a pointer to where the full +notice is found. + + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or +your school, if any, to sign a "copyright disclaimer" for the library, +if necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James + Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + + diff --git a/FileManip.cabal b/FileManip.cabal index 9904cd9..26e2a9b 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -1,6 +1,7 @@ Name: FileManip Version: 0.1 License: LGPL +License-File: COPYING.LIB Author: Bryan O'Sullivan Maintainer: Bryan O'Sullivan Synopsis: File and directory manipulation library for Haskell From 28394b9ba1e2d627a545ab46e25d648029707884 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Tue, 1 May 2007 05:59:11 +0000 Subject: [PATCH 16/67] Drop trace import. --HG-- extra : convert_revision : c455b43965598e8d3e94e4528d049aed1c724eb9 --- System/FilePath/Find.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 8587d20..c2c9991 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -77,7 +77,6 @@ import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) import qualified Control.Exception as E import qualified System.Posix.Files as F import qualified System.Posix.Types as T -import Debug.Trace data FileInfo = FileInfo { From 5a8bbe8ac81b536af36bd0cbbfac4225e7eccf5b Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Tue, 1 May 2007 05:59:22 +0000 Subject: [PATCH 17/67] Tweaklet. --HG-- extra : convert_revision : 979fcb3601237594b93d678cd9c0bb1a8cd8deba --- FileManip.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/FileManip.cabal b/FileManip.cabal index 26e2a9b..d65cf31 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -4,11 +4,11 @@ License: LGPL License-File: COPYING.LIB Author: Bryan O'Sullivan Maintainer: Bryan O'Sullivan -Synopsis: File and directory manipulation library for Haskell +Synopsis: File and directory manipulation for Haskell. Category: System Description: A Haskell library for working with files and directories. - Includes modules for pattern matching, finding files, - and more. + Includes code for pattern matching, finding files, + modifying file contents, and more. Build-Depends: base, filepath, mtl, unix GHC-Options: -Wall Exposed-Modules: From 812f087b8897f42bc32492b9e8468967e35ec8d1 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Tue, 1 May 2007 06:24:44 +0000 Subject: [PATCH 18/67] More docs. --HG-- extra : convert_revision : 6c759d41ec6d42d9758387265051a24e82b4c566 --- System/FilePath/Find.hs | 77 +++++++++++++++++++++++++++++------------ 1 file changed, 55 insertions(+), 22 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index c2c9991..0564042 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -78,48 +78,58 @@ import qualified Control.Exception as E import qualified System.Posix.Files as F import qualified System.Posix.Types as T +-- | Information collected during the traversal of a directory. data FileInfo = FileInfo { - infoPath :: FilePath - , infoDepth :: Int - , infoStatus :: F.FileStatus + infoPath :: FilePath -- ^ file path + , 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 +-- | Construct a 'FileInfo' value. + mkFI :: FilePath -> Int -> F.FileStatus -> FileInfo mkFI = FileInfo -newtype FindClause a = FI { runFI :: State FileInfo a } +-- | Monadic container for file information, allowing for clean +-- construction of combinators. Wraps the 'State' monad, but doesn't +-- allow 'get' or 'put'. +newtype FindClause a = FC { runFC :: State FileInfo a } deriving (Functor, Monad) +-- | Run the given find clause and return a pure value. evalFI :: FindClause a -> FilePath -> Int -> F.FileStatus -> a - -evalFI m p d s = evalState (runFI m) (mkFI p d s) +evalFI m p d s = evalState (runFC m) (mkFI p d s) mkFindClause :: (FileInfo -> (a, FileInfo)) -> FindClause a -mkFindClause = FI . State +mkFindClause = FC . State +-- | 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 @@ -127,6 +137,8 @@ fileStatus = infoStatus `liftM` fileInfo type FilterPredicate = FindClause Bool type RecursionPredicate = FindClause Bool +-- | List the files in the given directory, sorted, and without \".\" +-- or \"..\". getDirContents :: FilePath -> IO [FilePath] getDirContents dir = (sort . filter goodName) `liftM` getDirectoryContents dir @@ -134,11 +146,15 @@ getDirContents dir = (sort . filter goodName) `liftM` getDirectoryContents dir goodName ".." = False goodName _ = True -findWithHandler :: (FilePath -> E.Exception -> IO [FilePath]) - -> RecursionPredicate - -> FilterPredicate - -> FilePath - -> IO [FilePath] +-- | 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' findWithHandler errHandler recurse filter path = E.handle (errHandler path) $ F.getSymbolicLinkStatus path >>= visit path 0 @@ -158,21 +174,31 @@ findWithHandler errHandler recurse filter path = then path:result else result -find :: RecursionPredicate - -> FilterPredicate - -> FilePath - -> IO [FilePath] +-- | 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 = findWithHandler warnOnError where warnOnError path err = hPutStrLn stderr (path ++ ": " ++ show err) >> return [] -foldWithHandler :: (FilePath -> a -> E.Exception -> IO a) - -> RecursionPredicate - -> (a -> FileInfo -> a) - -> a - -> FilePath - -> IO a +-- | 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 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. +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) $ @@ -188,6 +214,13 @@ foldWithHandler errHandler recurse f state path = 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 From 37398ede967662decf3e1e9d8aab70703b64574e Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Wed, 2 May 2007 05:55:51 +0000 Subject: [PATCH 19/67] Add README. --HG-- extra : convert_revision : cef02b74aefb1f81aa48f4e7b55c09cb09263c02 --- FileManip.cabal | 3 ++- README | 29 +++++++++++++++++++++++++++++ 2 files changed, 31 insertions(+), 1 deletion(-) create mode 100644 README diff --git a/FileManip.cabal b/FileManip.cabal index d65cf31..e72416d 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -4,7 +4,7 @@ License: LGPL License-File: COPYING.LIB Author: Bryan O'Sullivan Maintainer: Bryan O'Sullivan -Synopsis: File and directory manipulation for Haskell. +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, @@ -15,3 +15,4 @@ Exposed-Modules: System.FilePath.Find, System.FilePath.GlobPattern, System.FilePath.Manip +Extra-Source-Files: README diff --git a/README b/README new file mode 100644 index 0000000..2b33e90 --- /dev/null +++ b/README @@ -0,0 +1,29 @@ +FileManip: expressive file manipulation +--------------------------------------- + +This package provides functions and combinators for searching, +matching, and manipulating files. + + +To build and install: + + runhaskell Setup configure + runhaskell Setup build + runhaskell Setup install + + +To understand: + + runhaskell Setup haddock + +Take a look at the generated documentation in dist/doc. + + +To contribute: + + darcs get http://darcs.serpentine.com/filemanip + + +Contributors: + + Bryan O'Sullivan From 0f2731767450e2a4c260a9d4220e390afaf02baf Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Wed, 2 May 2007 05:56:32 +0000 Subject: [PATCH 20/67] Add docs. --HG-- extra : convert_revision : 88e724524fcf29c16f7217de5e0886195cbf60ce --- System/FilePath/Find.hs | 236 ++++++++++++++++++++++++++++----- System/FilePath/GlobPattern.hs | 36 +++++ 2 files changed, 236 insertions(+), 36 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 0564042..e415ac7 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -7,6 +7,33 @@ -- Maintainer: Bryan O'Sullivan -- 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 >? ( 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 &&? diff --git a/System/FilePath/GlobPattern.hs b/System/FilePath/GlobPattern.hs index 56babc4..dbc8ad5 100644 --- a/System/FilePath/GlobPattern.hs +++ b/System/FilePath/GlobPattern.hs @@ -1,5 +1,15 @@ +-- | +-- Module: System.FilePath.GlobPattern +-- Copyright: Bryan O'Sullivan +-- License: LGPL +-- Maintainer: Bryan O'Sullivan +-- 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 . ) . (~~) From 892054acc3eb8328baf480b842a1ad1bc315d557 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Wed, 2 May 2007 06:02:56 +0000 Subject: [PATCH 21/67] Turn on optimisation. --HG-- extra : convert_revision : 170753ea8470544bcc51c89326b9eadf70ab012e --- FileManip.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/FileManip.cabal b/FileManip.cabal index e72416d..2160e8c 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -10,7 +10,7 @@ Description: A Haskell library for working with files and directories. Includes code for pattern matching, finding files, modifying file contents, and more. Build-Depends: base, filepath, mtl, unix -GHC-Options: -Wall +GHC-Options: -Wall -O2 Exposed-Modules: System.FilePath.Find, System.FilePath.GlobPattern, From 5e7e0d5cf9ad48dbca6c4079c07553eda36c22c7 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Wed, 2 May 2007 06:05:52 +0000 Subject: [PATCH 22/67] Update README with URL for docs. --HG-- extra : convert_revision : 07b69ee7562e97f495e6a7d6fd154b98d002f059 --- README | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/README b/README index 2b33e90..77b93bf 100644 --- a/README +++ b/README @@ -14,9 +14,8 @@ To build and install: To understand: - runhaskell Setup haddock + http://darcs.serpentine.com/filemanip/dist/doc/html/FileManip/ -Take a look at the generated documentation in dist/doc. To contribute: From 097afc9831193a5cb124a2ea93ff65c270056722 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 24 Jun 2007 16:30:41 +0000 Subject: [PATCH 24/67] Add Glob module, update docs. --HG-- extra : convert_revision : e114cb9154838d7f74c72671db22dbddb97e3a58 --- FileManip.cabal | 1 + README | 22 +++++++++++ System/FilePath/Glob.hs | 72 ++++++++++++++++++++++++++++++++++ System/FilePath/GlobPattern.hs | 6 +-- examples/Simple.hs | 12 ++++++ 5 files changed, 110 insertions(+), 3 deletions(-) create mode 100644 System/FilePath/Glob.hs diff --git a/FileManip.cabal b/FileManip.cabal index 2160e8c..165b727 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -13,6 +13,7 @@ Build-Depends: base, filepath, mtl, unix GHC-Options: -Wall -O2 Exposed-Modules: System.FilePath.Find, + System.FilePath.Glob, System.FilePath.GlobPattern, System.FilePath.Manip Extra-Source-Files: README diff --git a/README b/README index 77b93bf..8f2735c 100644 --- a/README +++ b/README @@ -4,6 +4,28 @@ FileManip: expressive file manipulation This package provides functions and combinators for searching, matching, and manipulating files. +It provides four modules. + +System.FilePath.Find lets you search a filesystem hierarchy efficiently: + + find always (extension ==? ".pl") >>= mapM_ remove + +System.FilePath.GlobPattern lets you perform glob-style pattern +matching, without going through a regexp engine: + + "foo.c" ~~ "*.c" ==> True + +System.FilePath.Glob lets you do simple glob-style file name searches: + + namesMatching "*/*.c" ==> ["foo/bar.c"] + +System.FilePath.Manip lets you rename files procedurally, edit files +in place, or save old copies as backups: + + modifyWithBackup (<.> "bak") + (unlines . map (takeWhile (/= ',')) . lines) + "myPoorFile.csv" + To build and install: diff --git a/System/FilePath/Glob.hs b/System/FilePath/Glob.hs new file mode 100644 index 0000000..0a2ceaa --- /dev/null +++ b/System/FilePath/Glob.hs @@ -0,0 +1,72 @@ +-- | +-- Module: System.FilePath.Glob +-- Copyright: Bryan O'Sullivan +-- License: LGPL +-- Maintainer: Bryan O'Sullivan +-- Stability: unstable +-- Portability: everywhere + +module System.FilePath.Glob ( + namesMatching + ) where + +import Control.Exception (handle) +import Control.Monad (forM) +import System.FilePath.GlobPattern ((~~)) +import System.Directory (doesDirectoryExist, doesFileExist, + getCurrentDirectory, getDirectoryContents) +import System.FilePath (dropTrailingPathSeparator, splitFileName, ()) +import System.IO.Unsafe (unsafeInterleaveIO) + +-- | Return a list of names matching a glob pattern. The list is +-- generated lazily. +namesMatching :: String -> IO [FilePath] +namesMatching pat + | not (isPattern pat) = do + exists <- doesNameExist pat + return (if exists then [pat] else []) + | otherwise = do + case splitFileName pat of + ("", baseName) -> do + curDir <- getCurrentDirectory + listMatches curDir baseName + (dirName, baseName) -> do + dirs <- if isPattern dirName + then namesMatching (dropTrailingPathSeparator dirName) + else return [dirName] + let listDir = if isPattern baseName + then listMatches + else listPlain + pathNames <- forM dirs $ \dir -> do + baseNames <- listDir dir baseName + return (map (dir ) baseNames) + return (concat pathNames) + where isPattern = any (`elem` "[*?") + +listMatches :: FilePath -> String -> IO [String] +listMatches dirName pat = do + dirName' <- if null dirName + then getCurrentDirectory + else return dirName + names <- unsafeInterleaveIO (handle (const (return [])) $ + getDirectoryContents dirName') + let names' = if isHidden pat + then filter isHidden names + else filter (not . isHidden) names + return (filter (~~ pat) names') + where isHidden ('.':_) = True + isHidden _ = False + +listPlain :: FilePath -> String -> IO [String] +listPlain dirName baseName = do + exists <- if null baseName + then doesDirectoryExist dirName + else doesNameExist (dirName baseName) + return (if exists then [baseName] else []) + +doesNameExist :: FilePath -> IO Bool +doesNameExist name = do + fileExists <- doesFileExist name + if fileExists + then return True + else doesDirectoryExist name diff --git a/System/FilePath/GlobPattern.hs b/System/FilePath/GlobPattern.hs index dbc8ad5..fa80d20 100644 --- a/System/FilePath/GlobPattern.hs +++ b/System/FilePath/GlobPattern.hs @@ -32,12 +32,12 @@ import System.FilePath (pathSeparator) -- -- * @[!/range/]@ matches any character /not/ in /range/. -- +-- There are three extensions to the traditional glob syntax, taken +-- from modern Unix shells. +-- -- * @\\@ 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. diff --git a/examples/Simple.hs b/examples/Simple.hs index 0370ef7..b49fc9c 100644 --- a/examples/Simple.hs +++ b/examples/Simple.hs @@ -1,7 +1,10 @@ import Control.Monad +import Codec.Compression.GZip import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy as L import System.FilePath import System.FilePath.Find +import System.FilePath.Glob import System.FilePath.Manip import Text.Regex.Posix ((=~)) @@ -68,3 +71,12 @@ recGrep :: String -> FilePath -> IO [(FilePath, Int, S.ByteString)] recGrep pat top = find always (fileType ==? RegularFile) top >>= mapM ((,,) >>= flip grepFile pat) >>= return . concat + + +-- Decompress all gzip files matching a fixed glob pattern, and return +-- the results as a single huge lazy ByteString. + +decomp :: IO L.ByteString + +decomp = namesMatching "*/*.gz" >>= + fmap L.concat . mapM (fmap decompress . L.readFile) From 0c75bbda33627390b00f19d18cb1cfd9e6153d29 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 24 Jun 2007 16:30:59 +0000 Subject: [PATCH 25/67] Bump version number. --HG-- extra : convert_revision : 3a171fe833d909cc48837d88835923e1d42a2684 --- FileManip.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/FileManip.cabal b/FileManip.cabal index 165b727..a0f38c2 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -1,5 +1,5 @@ Name: FileManip -Version: 0.1 +Version: 0.2 License: LGPL License-File: COPYING.LIB Author: Bryan O'Sullivan From 09544e1403ba30e51a7220cd049b4ce3988cc17c Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 24 Jun 2007 16:59:43 +0000 Subject: [PATCH 26/67] Strictify the fold. --HG-- extra : convert_revision : 879510c3a41039e46f4cd117381470a82861d049 --- System/FilePath/Find.hs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index e415ac7..44fd935 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -249,10 +249,11 @@ find = findWithHandler warnOnError -- | 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 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. +-- 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 @@ -267,10 +268,12 @@ foldWithHandler errHandler recurse f state path = where visit state path depth st = if F.isDirectory st && evalFI recurse path depth st then traverse state path (succ depth) st - else return (f state (mkFI path 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 >>= - flip foldM (f state (mkFI dir depth dirSt)) (\state name -> + 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) From e8644cb930c5f96d25330e9511b6f2e643780a56 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Mon, 5 Nov 2007 07:09:32 +0000 Subject: [PATCH 27/67] Manip.hs uses TypeSynonymInstances --HG-- extra : convert_revision : ba99de4c3ae7ee9d9d97f3117c3a5ca582f3d569 --- System/FilePath/Manip.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/System/FilePath/Manip.hs b/System/FilePath/Manip.hs index 4b721a8..01308d1 100644 --- a/System/FilePath/Manip.hs +++ b/System/FilePath/Manip.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} -- | -- Module: System.FilePath.Manip From 258fcb3587caf945a82c1a0646f1453195625d1e Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Fri, 9 Nov 2007 05:39:32 +0000 Subject: [PATCH 28/67] Build with GHC 6.8.1. --HG-- extra : convert_revision : 87b71debe80aa21e0a6bc03f7fb871f5ec9a52ca --- FileManip.cabal | 48 +++++++++++++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 19 deletions(-) diff --git a/FileManip.cabal b/FileManip.cabal index a0f38c2..7ff4f3c 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -1,19 +1,29 @@ -Name: FileManip -Version: 0.2 -License: LGPL -License-File: COPYING.LIB -Author: Bryan O'Sullivan -Maintainer: Bryan O'Sullivan -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-Depends: base, filepath, mtl, unix -GHC-Options: -Wall -O2 -Exposed-Modules: - System.FilePath.Find, - System.FilePath.Glob, - System.FilePath.GlobPattern, - System.FilePath.Manip -Extra-Source-Files: README +Name: FileManip +Version: 0.2 +License: LGPL +License-File: COPYING.LIB +Author: Bryan O'Sullivan +Maintainer: Bryan O'Sullivan +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. +Cabal-version: >= 1.2 + +Flag splitBase + Description: Choose the new, split-up base package. + +Library + if flag(splitBase) + Build-Depends: base, bytestring, directory, filepath, mtl, unix + else + Build-Depends: base, filepath, mtl, unix + + GHC-Options: -Wall -O2 + Exposed-Modules: + System.FilePath.Find, + System.FilePath.Glob, + System.FilePath.GlobPattern, + System.FilePath.Manip + Extra-Source-Files: README From d3803fde453cea4a6074ecab09f2f7d82ebe6e4b Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Fri, 9 Nov 2007 05:40:05 +0000 Subject: [PATCH 29/67] Bump version. --HG-- extra : convert_revision : 19d383ca6bd025f2e7d57447daa331dc9e4a2e9a --- FileManip.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/FileManip.cabal b/FileManip.cabal index 7ff4f3c..c5fc693 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -1,5 +1,5 @@ Name: FileManip -Version: 0.2 +Version: 0.3 License: LGPL License-File: COPYING.LIB Author: Bryan O'Sullivan From 9bb70471ad903d6d7ca6c1f79c54876a581a8779 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Fri, 9 Nov 2007 05:43:05 +0000 Subject: [PATCH 31/67] Switch license to BSD3. --HG-- extra : convert_revision : 982640494cd0d6601b206adf942eb173d7c95a5d --- COPYING.LIB | 510 ------------------------------------------------ FileManip.cabal | 6 +- 2 files changed, 3 insertions(+), 513 deletions(-) delete mode 100644 COPYING.LIB diff --git a/COPYING.LIB b/COPYING.LIB deleted file mode 100644 index cf9b6b9..0000000 --- a/COPYING.LIB +++ /dev/null @@ -1,510 +0,0 @@ - - GNU LESSER GENERAL PUBLIC LICENSE - Version 2.1, February 1999 - - Copyright (C) 1991, 1999 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -[This is the first released version of the Lesser GPL. It also counts - as the successor of the GNU Library Public License, version 2, hence - the version number 2.1.] - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -Licenses are intended to guarantee your freedom to share and change -free software--to make sure the software is free for all its users. - - This license, the Lesser General Public License, applies to some -specially designated software packages--typically libraries--of the -Free Software Foundation and other authors who decide to use it. You -can use it too, but we suggest you first think carefully about whether -this license or the ordinary General Public License is the better -strategy to use in any particular case, based on the explanations -below. - - When we speak of free software, we are referring to freedom of use, -not price. Our General Public Licenses are designed to make sure that -you have the freedom to distribute copies of free software (and charge -for this service if you wish); that you receive source code or can get -it if you want it; that you can change the software and use pieces of -it in new free programs; and that you are informed that you can do -these things. - - To protect your rights, we need to make restrictions that forbid -distributors to deny you these rights or to ask you to surrender these -rights. These restrictions translate to certain responsibilities for -you if you distribute copies of the library or if you modify it. - - For example, if you distribute copies of the library, whether gratis -or for a fee, you must give the recipients all the rights that we gave -you. You must make sure that they, too, receive or can get the source -code. If you link other code with the library, you must provide -complete object files to the recipients, so that they can relink them -with the library after making changes to the library and recompiling -it. And you must show them these terms so they know their rights. - - We protect your rights with a two-step method: (1) we copyright the -library, and (2) we offer you this license, which gives you legal -permission to copy, distribute and/or modify the library. - - To protect each distributor, we want to make it very clear that -there is no warranty for the free library. Also, if the library is -modified by someone else and passed on, the recipients should know -that what they have is not the original version, so that the original -author's reputation will not be affected by problems that might be -introduced by others. -^L - Finally, software patents pose a constant threat to the existence of -any free program. We wish to make sure that a company cannot -effectively restrict the users of a free program by obtaining a -restrictive license from a patent holder. Therefore, we insist that -any patent license obtained for a version of the library must be -consistent with the full freedom of use specified in this license. - - Most GNU software, including some libraries, is covered by the -ordinary GNU General Public License. This license, the GNU Lesser -General Public License, applies to certain designated libraries, and -is quite different from the ordinary General Public License. We use -this license for certain libraries in order to permit linking those -libraries into non-free programs. - - When a program is linked with a library, whether statically or using -a shared library, the combination of the two is legally speaking a -combined work, a derivative of the original library. The ordinary -General Public License therefore permits such linking only if the -entire combination fits its criteria of freedom. The Lesser General -Public License permits more lax criteria for linking other code with -the library. - - We call this license the "Lesser" General Public License because it -does Less to protect the user's freedom than the ordinary General -Public License. It also provides other free software developers Less -of an advantage over competing non-free programs. These disadvantages -are the reason we use the ordinary General Public License for many -libraries. However, the Lesser license provides advantages in certain -special circumstances. - - For example, on rare occasions, there may be a special need to -encourage the widest possible use of a certain library, so that it -becomes a de-facto standard. To achieve this, non-free programs must -be allowed to use the library. A more frequent case is that a free -library does the same job as widely used non-free libraries. In this -case, there is little to gain by limiting the free library to free -software only, so we use the Lesser General Public License. - - In other cases, permission to use a particular library in non-free -programs enables a greater number of people to use a large body of -free software. For example, permission to use the GNU C Library in -non-free programs enables many more people to use the whole GNU -operating system, as well as its variant, the GNU/Linux operating -system. - - Although the Lesser General Public License is Less protective of the -users' freedom, it does ensure that the user of a program that is -linked with the Library has the freedom and the wherewithal to run -that program using a modified version of the Library. - - The precise terms and conditions for copying, distribution and -modification follow. Pay close attention to the difference between a -"work based on the library" and a "work that uses the library". The -former contains code derived from the library, whereas the latter must -be combined with the library in order to run. -^L - GNU LESSER GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License Agreement applies to any software library or other -program which contains a notice placed by the copyright holder or -other authorized party saying it may be distributed under the terms of -this Lesser General Public License (also called "this License"). -Each licensee is addressed as "you". - - A "library" means a collection of software functions and/or data -prepared so as to be conveniently linked with application programs -(which use some of those functions and data) to form executables. - - The "Library", below, refers to any such software library or work -which has been distributed under these terms. A "work based on the -Library" means either the Library or any derivative work under -copyright law: that is to say, a work containing the Library or a -portion of it, either verbatim or with modifications and/or translated -straightforwardly into another language. (Hereinafter, translation is -included without limitation in the term "modification".) - - "Source code" for a work means the preferred form of the work for -making modifications to it. For a library, complete source code means -all the source code for all modules it contains, plus any associated -interface definition files, plus the scripts used to control -compilation and installation of the library. - - Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running a program using the Library is not restricted, and output from -such a program is covered only if its contents constitute a work based -on the Library (independent of the use of the Library in a tool for -writing it). Whether that is true depends on what the Library does -and what the program that uses the Library does. - - 1. You may copy and distribute verbatim copies of the Library's -complete source code as you receive it, in any medium, provided that -you conspicuously and appropriately publish on each copy an -appropriate copyright notice and disclaimer of warranty; keep intact -all the notices that refer to this License and to the absence of any -warranty; and distribute a copy of this License along with the -Library. - - You may charge a fee for the physical act of transferring a copy, -and you may at your option offer warranty protection in exchange for a -fee. - - 2. You may modify your copy or copies of the Library or any portion -of it, thus forming a work based on the Library, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) The modified work must itself be a software library. - - b) You must cause the files modified to carry prominent notices - stating that you changed the files and the date of any change. - - c) You must cause the whole of the work to be licensed at no - charge to all third parties under the terms of this License. - - d) If a facility in the modified Library refers to a function or a - table of data to be supplied by an application program that uses - the facility, other than as an argument passed when the facility - is invoked, then you must make a good faith effort to ensure that, - in the event an application does not supply such function or - table, the facility still operates, and performs whatever part of - its purpose remains meaningful. - - (For example, a function in a library to compute square roots has - a purpose that is entirely well-defined independent of the - application. Therefore, Subsection 2d requires that any - application-supplied function or table used by this function must - be optional: if the application does not supply it, the square - root function must still compute square roots.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Library, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Library, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote -it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Library. - -In addition, mere aggregation of another work not based on the Library -with the Library (or with a work based on the Library) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may opt to apply the terms of the ordinary GNU General Public -License instead of this License to a given copy of the Library. To do -this, you must alter all the notices that refer to this License, so -that they refer to the ordinary GNU General Public License, version 2, -instead of to this License. (If a newer version than version 2 of the -ordinary GNU General Public License has appeared, then you can specify -that version instead if you wish.) Do not make any other change in -these notices. -^L - Once this change is made in a given copy, it is irreversible for -that copy, so the ordinary GNU General Public License applies to all -subsequent copies and derivative works made from that copy. - - This option is useful when you wish to copy part of the code of -the Library into a program that is not a library. - - 4. You may copy and distribute the Library (or a portion or -derivative of it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you accompany -it with the complete corresponding machine-readable source code, which -must be distributed under the terms of Sections 1 and 2 above on a -medium customarily used for software interchange. - - If distribution of object code is made by offering access to copy -from a designated place, then offering equivalent access to copy the -source code from the same place satisfies the requirement to -distribute the source code, even though third parties are not -compelled to copy the source along with the object code. - - 5. A program that contains no derivative of any portion of the -Library, but is designed to work with the Library by being compiled or -linked with it, is called a "work that uses the Library". Such a -work, in isolation, is not a derivative work of the Library, and -therefore falls outside the scope of this License. - - However, linking a "work that uses the Library" with the Library -creates an executable that is a derivative of the Library (because it -contains portions of the Library), rather than a "work that uses the -library". The executable is therefore covered by this License. -Section 6 states terms for distribution of such executables. - - When a "work that uses the Library" uses material from a header file -that is part of the Library, the object code for the work may be a -derivative work of the Library even though the source code is not. -Whether this is true is especially significant if the work can be -linked without the Library, or if the work is itself a library. The -threshold for this to be true is not precisely defined by law. - - If such an object file uses only numerical parameters, data -structure layouts and accessors, and small macros and small inline -functions (ten lines or less in length), then the use of the object -file is unrestricted, regardless of whether it is legally a derivative -work. (Executables containing this object code plus portions of the -Library will still fall under Section 6.) - - Otherwise, if the work is a derivative of the Library, you may -distribute the object code for the work under the terms of Section 6. -Any executables containing that work also fall under Section 6, -whether or not they are linked directly with the Library itself. -^L - 6. As an exception to the Sections above, you may also combine or -link a "work that uses the Library" with the Library to produce a -work containing portions of the Library, and distribute that work -under terms of your choice, provided that the terms permit -modification of the work for the customer's own use and reverse -engineering for debugging such modifications. - - You must give prominent notice with each copy of the work that the -Library is used in it and that the Library and its use are covered by -this License. You must supply a copy of this License. If the work -during execution displays copyright notices, you must include the -copyright notice for the Library among them, as well as a reference -directing the user to the copy of this License. Also, you must do one -of these things: - - a) Accompany the work with the complete corresponding - machine-readable source code for the Library including whatever - changes were used in the work (which must be distributed under - Sections 1 and 2 above); and, if the work is an executable linked - with the Library, with the complete machine-readable "work that - uses the Library", as object code and/or source code, so that the - user can modify the Library and then relink to produce a modified - executable containing the modified Library. (It is understood - that the user who changes the contents of definitions files in the - Library will not necessarily be able to recompile the application - to use the modified definitions.) - - b) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (1) uses at run time a - copy of the library already present on the user's computer system, - rather than copying library functions into the executable, and (2) - will operate properly with a modified version of the library, if - the user installs one, as long as the modified version is - interface-compatible with the version that the work was made with. - - c) Accompany the work with a written offer, valid for at least - three years, to give the same user the materials specified in - Subsection 6a, above, for a charge no more than the cost of - performing this distribution. - - d) If distribution of the work is made by offering access to copy - from a designated place, offer equivalent access to copy the above - specified materials from the same place. - - e) Verify that the user has already received a copy of these - materials or that you have already sent this user a copy. - - For an executable, the required form of the "work that uses the -Library" must include any data and utility programs needed for -reproducing the executable from it. However, as a special exception, -the materials to be distributed need not include anything that is -normally distributed (in either source or binary form) with the major -components (compiler, kernel, and so on) of the operating system on -which the executable runs, unless that component itself accompanies -the executable. - - It may happen that this requirement contradicts the license -restrictions of other proprietary libraries that do not normally -accompany the operating system. Such a contradiction means you cannot -use both them and the Library together in an executable that you -distribute. -^L - 7. You may place library facilities that are a work based on the -Library side-by-side in a single library together with other library -facilities not covered by this License, and distribute such a combined -library, provided that the separate distribution of the work based on -the Library and of the other library facilities is otherwise -permitted, and provided that you do these two things: - - a) Accompany the combined library with a copy of the same work - based on the Library, uncombined with any other library - facilities. This must be distributed under the terms of the - Sections above. - - b) Give prominent notice with the combined library of the fact - that part of it is a work based on the Library, and explaining - where to find the accompanying uncombined form of the same work. - - 8. You may not copy, modify, sublicense, link with, or distribute -the Library except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense, link with, or -distribute the Library is void, and will automatically terminate your -rights under this License. However, parties who have received copies, -or rights, from you under this License will not have their licenses -terminated so long as such parties remain in full compliance. - - 9. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Library or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Library (or any work based on the -Library), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Library or works based on it. - - 10. Each time you redistribute the Library (or any work based on the -Library), the recipient automatically receives a license from the -original licensor to copy, distribute, link with or modify the Library -subject to these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties with -this License. -^L - 11. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Library at all. For example, if a patent -license would not permit royalty-free redistribution of the Library by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Library. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply, and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 12. If the distribution and/or use of the Library is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Library under this License -may add an explicit geographical distribution limitation excluding those -countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 13. The Free Software Foundation may publish revised and/or new -versions of the Lesser General Public License from time to time. -Such new versions will be similar in spirit to the present version, -but may differ in detail to address new problems or concerns. - -Each version is given a distinguishing version number. If the Library -specifies a version number of this License which applies to it and -"any later version", you have the option of following the terms and -conditions either of that version or of any later version published by -the Free Software Foundation. If the Library does not specify a -license version number, you may choose any version ever published by -the Free Software Foundation. -^L - 14. If you wish to incorporate parts of the Library into other free -programs whose distribution conditions are incompatible with these, -write to the author to ask for permission. For software which is -copyrighted by the Free Software Foundation, write to the Free -Software Foundation; we sometimes make exceptions for this. Our -decision will be guided by the two goals of preserving the free status -of all derivatives of our free software and of promoting the sharing -and reuse of software generally. - - NO WARRANTY - - 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO -WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. -EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR -OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY -KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE -LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME -THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN -WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY -AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU -FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR -CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE -LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING -RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A -FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -DAMAGES. - - END OF TERMS AND CONDITIONS -^L - How to Apply These Terms to Your New Libraries - - If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms -of the ordinary General Public License). - - To apply these terms, attach the following notices to the library. -It is safest to attach them to the start of each source file to most -effectively convey the exclusion of warranty; and each file should -have at least the "copyright" line and a pointer to where the full -notice is found. - - - - Copyright (C) - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or -your school, if any, to sign a "copyright disclaimer" for the library, -if necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James - Random Hacker. - - , 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! - - diff --git a/FileManip.cabal b/FileManip.cabal index c5fc693..be86de6 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -1,7 +1,7 @@ Name: FileManip -Version: 0.3 -License: LGPL -License-File: COPYING.LIB +Version: 0.3.1 +License: BSD3 +License-File: LICENSE Author: Bryan O'Sullivan Maintainer: Bryan O'Sullivan Synopsis: Expressive file and directory manipulation for Haskell. From 323ce1df1b5d65e3133c97dc82ec65355023d118 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 3 Feb 2008 17:52:21 +0000 Subject: [PATCH 33/67] Fix reference to LGPL in sources --HG-- extra : convert_revision : b39042cb836780b9c8e7902149b8fb86a6a8b49d --- FileManip.cabal | 2 +- System/FilePath/Find.hs | 2 +- System/FilePath/Glob.hs | 2 +- System/FilePath/GlobPattern.hs | 2 +- System/FilePath/Manip.hs | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/FileManip.cabal b/FileManip.cabal index be86de6..cb1a311 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -1,5 +1,5 @@ Name: FileManip -Version: 0.3.1 +Version: 0.3.2 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 44fd935..eb8d6b5 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -3,7 +3,7 @@ -- | -- Module: System.FilePath.Find -- Copyright: Bryan O'Sullivan --- License: LGPL +-- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: unstable -- Portability: Unix-like systems (requires newtype deriving) diff --git a/System/FilePath/Glob.hs b/System/FilePath/Glob.hs index 0a2ceaa..e44b368 100644 --- a/System/FilePath/Glob.hs +++ b/System/FilePath/Glob.hs @@ -1,7 +1,7 @@ -- | -- Module: System.FilePath.Glob -- Copyright: Bryan O'Sullivan --- License: LGPL +-- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: unstable -- Portability: everywhere diff --git a/System/FilePath/GlobPattern.hs b/System/FilePath/GlobPattern.hs index fa80d20..7299de0 100644 --- a/System/FilePath/GlobPattern.hs +++ b/System/FilePath/GlobPattern.hs @@ -1,7 +1,7 @@ -- | -- Module: System.FilePath.GlobPattern -- Copyright: Bryan O'Sullivan --- License: LGPL +-- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: unstable -- Portability: everywhere diff --git a/System/FilePath/Manip.hs b/System/FilePath/Manip.hs index 01308d1..3b4a26a 100644 --- a/System/FilePath/Manip.hs +++ b/System/FilePath/Manip.hs @@ -3,7 +3,7 @@ -- | -- Module: System.FilePath.Manip -- Copyright: Bryan O'Sullivan --- License: LGPL +-- License: BSD3 -- Maintainer: Bryan O'Sullivan -- Stability: unstable -- Portability: Unix-like systems (requires flexible instances) From 00268534578f0bd516caab9f7181f6d5fa8afbbf Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 3 Feb 2008 17:53:46 +0000 Subject: [PATCH 35/67] Fix Cabal complaint --HG-- extra : convert_revision : a843333418d1426bd965be9d856fafe8f97fd0de --- FileManip.cabal | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/FileManip.cabal b/FileManip.cabal index cb1a311..5cbb979 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -1,15 +1,16 @@ -Name: FileManip -Version: 0.3.2 -License: BSD3 -License-File: LICENSE -Author: Bryan O'Sullivan -Maintainer: Bryan O'Sullivan -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. -Cabal-version: >= 1.2 +Name: FileManip +Version: 0.3.2 +License: BSD3 +License-File: LICENSE +Author: Bryan O'Sullivan +Maintainer: Bryan O'Sullivan +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. +Cabal-version: >= 1.2 +Extra-Source-Files: README Flag splitBase Description: Choose the new, split-up base package. @@ -26,4 +27,3 @@ Library System.FilePath.Glob, System.FilePath.GlobPattern, System.FilePath.Manip - Extra-Source-Files: README From fb34509cf177fe964a6b28b831443e73634a0fde Mon Sep 17 00:00:00 2001 From: Sergei Trofimovich Date: Fri, 5 Mar 2010 21:19:53 +0000 Subject: [PATCH 37/67] FileManip: migrated to extenible-exceptions --HG-- extra : convert_revision : 65e5f9c80e000fc9680da857ea7a255f3125b614 --- FileManip.cabal | 8 ++++++-- System/FilePath/Error.hs | 42 ++++++++++++++++++++++++++++++++++++++++ System/FilePath/Find.hs | 2 +- System/FilePath/Glob.hs | 3 ++- System/FilePath/Manip.hs | 3 ++- 5 files changed, 53 insertions(+), 5 deletions(-) create mode 100644 System/FilePath/Error.hs diff --git a/FileManip.cabal b/FileManip.cabal index 5cbb979..ea7edb6 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -10,6 +10,8 @@ Description: A Haskell library for working with files and directories. Includes code for pattern matching, finding files, modifying file contents, and more. Cabal-version: >= 1.2 +Build-type: Simple + Extra-Source-Files: README Flag splitBase @@ -17,9 +19,9 @@ Flag splitBase Library if flag(splitBase) - Build-Depends: base, bytestring, directory, filepath, mtl, unix + Build-Depends: base >= 2 && < 5, bytestring, directory, filepath, mtl, unix, extensible-exceptions else - Build-Depends: base, filepath, mtl, unix + Build-Depends: base >= 2 && < 5, filepath, mtl, unix, extensible-exceptions GHC-Options: -Wall -O2 Exposed-Modules: @@ -27,3 +29,5 @@ Library System.FilePath.Glob, System.FilePath.GlobPattern, System.FilePath.Manip + Other-Modules: + System.FilePath.Error diff --git a/System/FilePath/Error.hs b/System/FilePath/Error.hs new file mode 100644 index 0000000..aabce41 --- /dev/null +++ b/System/FilePath/Error.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} + +-- | +-- Module: System.FilePath.Manip +-- Copyright: Sergei Trofimovich +-- License: BSD3 +-- Maintainer: Bryan O'Sullivan +-- Stability: unstable +-- Portability: Unix-like systems (requires flexible instances) + +module System.FilePath.Error + ( + bracket + , bracket_ + , catch + , handle + , throwIO + , Exception + ) where + +import qualified Control.Exception.Extensible as EE +import Prelude hiding (catch) + +-- we can catch any exceptions if we need to +-- type Exception = SomeException +type Exception = EE.IOException + +-- we just pin down 'EE.Exception e' to local Exception +bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c +bracket = EE.bracket + +bracket_ :: IO a -> IO b -> IO c -> IO c +bracket_ = EE.bracket_ + +catch :: IO a -> (Exception -> IO a) -> IO a +catch = EE.catch + +handle :: (Exception -> IO a) -> IO a -> IO a +handle = EE.handle + +throwIO :: (EE.Exception e) => e -> IO a +throwIO = EE.throwIO diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index eb8d6b5..73aa90c 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -119,7 +119,7 @@ import System.FilePath ((), takeDirectory, takeExtension, takeFileName) import System.FilePath.GlobPattern (GlobPattern, (~~), (/~)) import System.IO (hPutStrLn, stderr) import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) -import qualified Control.Exception as E +import qualified System.FilePath.Error as E import qualified System.Posix.Files as F import qualified System.Posix.Types as T diff --git a/System/FilePath/Glob.hs b/System/FilePath/Glob.hs index e44b368..0164608 100644 --- a/System/FilePath/Glob.hs +++ b/System/FilePath/Glob.hs @@ -10,7 +10,6 @@ module System.FilePath.Glob ( namesMatching ) where -import Control.Exception (handle) import Control.Monad (forM) import System.FilePath.GlobPattern ((~~)) import System.Directory (doesDirectoryExist, doesFileExist, @@ -18,6 +17,8 @@ import System.Directory (doesDirectoryExist, doesFileExist, import System.FilePath (dropTrailingPathSeparator, splitFileName, ()) import System.IO.Unsafe (unsafeInterleaveIO) +import System.FilePath.Error (handle) + -- | Return a list of names matching a glob pattern. The list is -- generated lazily. namesMatching :: String -> IO [FilePath] diff --git a/System/FilePath/Manip.hs b/System/FilePath/Manip.hs index 3b4a26a..2dad4a9 100644 --- a/System/FilePath/Manip.hs +++ b/System/FilePath/Manip.hs @@ -16,7 +16,8 @@ module System.FilePath.Manip ( , modifyInPlace ) where -import Control.Exception (bracket, bracket_, handle, throwIO) +import System.FilePath.Error (bracket, bracket_, handle, throwIO) + import Control.Monad (liftM) import Data.Bits ((.&.)) import System.Directory (removeFile) From ee4fde32a30b51feecd5334857338a4a0459811c Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sat, 10 Jul 2010 15:46:29 +0000 Subject: [PATCH 38/67] Bump version --HG-- extra : convert_revision : 715603529a4f11b9dda919dc301cc703168cfc0a --- FileManip.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/FileManip.cabal b/FileManip.cabal index ea7edb6..d4ae173 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -1,5 +1,5 @@ Name: FileManip -Version: 0.3.2 +Version: 0.3.3 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan From 7cfcde5ec605cb6c0c322480f736758f39201a85 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sat, 10 Jul 2010 15:47:21 +0000 Subject: [PATCH 39/67] Add license file. --HG-- extra : convert_revision : 7ce948f870fa1ac2610d75ec8634af29143c07f7 --- LICENSE | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 LICENSE diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..55f8076 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) Bryan O'Sullivan 2007, 2010. + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. From c6b391578fc3080feec5390bb3497bb709db2863 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sat, 10 Jul 2010 15:47:48 +0000 Subject: [PATCH 40/67] Drop -O2 --HG-- extra : convert_revision : 2a9728593ca2a69d5ab23eb7e226cac4a2f58725 --- FileManip.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/FileManip.cabal b/FileManip.cabal index d4ae173..0efd770 100644 --- a/FileManip.cabal +++ b/FileManip.cabal @@ -23,7 +23,7 @@ Library else Build-Depends: base >= 2 && < 5, filepath, mtl, unix, extensible-exceptions - GHC-Options: -Wall -O2 + GHC-Options: -Wall Exposed-Modules: System.FilePath.Find, System.FilePath.Glob, From 0fa21022e94c06f20598ae9a3e520983de9320cc Mon Sep 17 00:00:00 2001 From: convert-repo Date: Mon, 11 Oct 2010 07:00:27 +0000 Subject: [PATCH 42/67] update tags --- .hgtags | 1 + 1 file changed, 1 insertion(+) create mode 100644 .hgtags diff --git a/.hgtags b/.hgtags new file mode 100644 index 0000000..b94f031 --- /dev/null +++ b/.hgtags @@ -0,0 +1 @@ +f76fcbbbfead7acb4d8323fb230155f06d2aad5b 0.3.3 From f2afffcfb3b8b0f47a73e85ea17b0cb2084e65e9 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 10 Oct 2010 16:03:56 -0700 Subject: [PATCH 43/67] Start to clean things up --HG-- rename : FileManip.cabal => filemanip.cabal --- .hgignore | 5 +++++ FileManip.cabal => filemanip.cabal | 13 +++---------- 2 files changed, 8 insertions(+), 10 deletions(-) create mode 100644 .hgignore rename FileManip.cabal => filemanip.cabal (65%) diff --git a/.hgignore b/.hgignore new file mode 100644 index 0000000..cd7fdde --- /dev/null +++ b/.hgignore @@ -0,0 +1,5 @@ +^dist$ +\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|swp)$ +~$ +syntax: glob +.\#* diff --git a/FileManip.cabal b/filemanip.cabal similarity index 65% rename from FileManip.cabal rename to filemanip.cabal index 0efd770..d643f80 100644 --- a/FileManip.cabal +++ b/filemanip.cabal @@ -1,5 +1,5 @@ -Name: FileManip -Version: 0.3.3 +Name: filemanip +Version: 0.4.0.0 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan @@ -9,19 +9,12 @@ Category: System Description: A Haskell library for working with files and directories. Includes code for pattern matching, finding files, modifying file contents, and more. -Cabal-version: >= 1.2 +Cabal-version: >= 1.6 Build-type: Simple Extra-Source-Files: README -Flag splitBase - Description: Choose the new, split-up base package. - Library - if flag(splitBase) - Build-Depends: base >= 2 && < 5, bytestring, directory, filepath, mtl, unix, extensible-exceptions - else - Build-Depends: base >= 2 && < 5, filepath, mtl, unix, extensible-exceptions GHC-Options: -Wall Exposed-Modules: From b2b548bb96ea710c44bc0fc56ba8b2cf5e9f17f5 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 10 Oct 2010 16:05:33 -0700 Subject: [PATCH 44/67] Update README --HG-- rename : README => README.markdown --- README | 50 ------------------------------------------------- README.markdown | 26 +++++++++++++++++++++++++ filemanip.cabal | 2 +- 3 files changed, 27 insertions(+), 51 deletions(-) delete mode 100644 README create mode 100644 README.markdown diff --git a/README b/README deleted file mode 100644 index 8f2735c..0000000 --- a/README +++ /dev/null @@ -1,50 +0,0 @@ -FileManip: expressive file manipulation ---------------------------------------- - -This package provides functions and combinators for searching, -matching, and manipulating files. - -It provides four modules. - -System.FilePath.Find lets you search a filesystem hierarchy efficiently: - - find always (extension ==? ".pl") >>= mapM_ remove - -System.FilePath.GlobPattern lets you perform glob-style pattern -matching, without going through a regexp engine: - - "foo.c" ~~ "*.c" ==> True - -System.FilePath.Glob lets you do simple glob-style file name searches: - - namesMatching "*/*.c" ==> ["foo/bar.c"] - -System.FilePath.Manip lets you rename files procedurally, edit files -in place, or save old copies as backups: - - modifyWithBackup (<.> "bak") - (unlines . map (takeWhile (/= ',')) . lines) - "myPoorFile.csv" - - -To build and install: - - runhaskell Setup configure - runhaskell Setup build - runhaskell Setup install - - -To understand: - - http://darcs.serpentine.com/filemanip/dist/doc/html/FileManip/ - - - -To contribute: - - darcs get http://darcs.serpentine.com/filemanip - - -Contributors: - - Bryan O'Sullivan diff --git a/README.markdown b/README.markdown new file mode 100644 index 0000000..f0e49fd --- /dev/null +++ b/README.markdown @@ -0,0 +1,26 @@ +# filemanip: expressive file manipulation + +This package provides functions and combinators for searching, +matching, and manipulating files. + + +# Get involved! + +Please report bugs via the +[bitbucket issue tracker](http://bitbucket.org/bos/attoparsec/filemanip). + +Master [Mercurial repository](http://bitbucket.org/bos/filemanip): + +* `hg clone http://bitbucket.org/bos/filemanip` + +There's also a [git mirror](http://github.com/bos/filemanip): + +* `git clone git://github.com/bos/filemanip.git` + +(You can create and contribute changes using either Mercurial or git.) + + +# Authors + +This library is written and maintained by Bryan O'Sullivan, +. diff --git a/filemanip.cabal b/filemanip.cabal index d643f80..64ed0cf 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -12,7 +12,7 @@ Description: A Haskell library for working with files and directories. Cabal-version: >= 1.6 Build-type: Simple -Extra-Source-Files: README +Extra-Source-Files: README.markdown Library From 5ebd0ab41231d69dfc96b9547d891e967cf9d9b6 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 10 Oct 2010 16:16:47 -0700 Subject: [PATCH 45/67] Get things building again --- System/FilePath/Error.hs | 42 ---------------------------------------- System/FilePath/Find.hs | 34 +++++++++++++++++--------------- System/FilePath/Glob.hs | 6 +++--- System/FilePath/Manip.hs | 11 +++++------ filemanip.cabal | 12 ++++++++---- 5 files changed, 34 insertions(+), 71 deletions(-) delete mode 100644 System/FilePath/Error.hs diff --git a/System/FilePath/Error.hs b/System/FilePath/Error.hs deleted file mode 100644 index aabce41..0000000 --- a/System/FilePath/Error.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} - --- | --- Module: System.FilePath.Manip --- Copyright: Sergei Trofimovich --- License: BSD3 --- Maintainer: Bryan O'Sullivan --- Stability: unstable --- Portability: Unix-like systems (requires flexible instances) - -module System.FilePath.Error - ( - bracket - , bracket_ - , catch - , handle - , throwIO - , Exception - ) where - -import qualified Control.Exception.Extensible as EE -import Prelude hiding (catch) - --- we can catch any exceptions if we need to --- type Exception = SomeException -type Exception = EE.IOException - --- we just pin down 'EE.Exception e' to local Exception -bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c -bracket = EE.bracket - -bracket_ :: IO a -> IO b -> IO c -> IO c -bracket_ = EE.bracket_ - -catch :: IO a -> (Exception -> IO a) -> IO a -catch = EE.catch - -handle :: (Exception -> IO a) -> IO a -> IO a -handle = EE.handle - -throwIO :: (EE.Exception e) => e -> IO a -throwIO = EE.throwIO diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 73aa90c..b66ff55 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module: System.FilePath.Find @@ -110,6 +111,7 @@ module System.FilePath.Find ( , (||?) ) where +import Control.Exception import Control.Monad (foldM, forM, liftM, liftM2) import Control.Monad.State (State(..), evalState) import Data.Bits (Bits, (.&.)) @@ -119,9 +121,9 @@ import System.FilePath ((), takeDirectory, takeExtension, takeFileName) import System.FilePath.GlobPattern (GlobPattern, (~~), (/~)) import System.IO (hPutStrLn, stderr) import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) -import qualified System.FilePath.Error as E -import qualified System.Posix.Files as F -import qualified System.Posix.Types as T +import qualified System.PosixCompat.Files as F +import qualified System.PosixCompat.Types as T +import Prelude hiding (catch) -- | Information collected during the traversal of a directory. data FileInfo = FileInfo @@ -210,27 +212,27 @@ getDirContents dir = (sort . filter goodName) `liftM` getDirectoryContents dir -- matching the given 'FilterPredicate'. Any errors that occur are -- dealt with by the given handler. findWithHandler :: - (FilePath -> E.Exception -> IO [FilePath]) -- ^ error handler + (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 'FilterPredicate' -findWithHandler errHandler recurse filter path = - E.handle (errHandler path) $ F.getSymbolicLinkStatus path >>= visit path 0 +findWithHandler errHandler recurse filt path0 = + handle (errHandler path0) $ F.getSymbolicLinkStatus path0 >>= visit path0 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 [] traverse dir depth dirSt = do - names <- E.catch (getDirContents dir) (errHandler dir) + names <- catch (getDirContents dir) (errHandler dir) filteredPaths <- forM names $ \name -> do let path = dir name - unsafeInterleaveIO $ E.handle (errHandler path) + unsafeInterleaveIO $ handle (errHandler path) (F.getSymbolicLinkStatus path >>= visit path depth) filterPath dir depth dirSt (concat filteredPaths) filterPath path depth st result = - return $ if evalFI filter path depth st + return $ if evalFI filt path depth st then path:result else result @@ -255,7 +257,7 @@ find = findWithHandler warnOnError -- right-to-left fold, use 'foldr' on the result of 'findWithHandler' -- instead. foldWithHandler - :: (FilePath -> a -> E.Exception -> IO a) -- ^ error 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 @@ -263,18 +265,18 @@ foldWithHandler -> IO a -- ^ final value after folding foldWithHandler errHandler recurse f state path = - E.handle (errHandler path state) $ + 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) $ + traverse state dir depth dirSt = 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) $ + handle (errHandler dir state) $ let path = dir name in F.getSymbolicLinkStatus path >>= visit state path depth) @@ -351,7 +353,7 @@ withLink f = do path <- filePath st <- fileStatus return $ if F.isSymbolicLink st - then unsafePerformIO $ E.handle (const (return Nothing)) $ + then unsafePerformIO $ handle (\(_::IOException) -> return Nothing) $ Just `liftM` f path else Nothing @@ -475,7 +477,7 @@ contains :: FilePath -> FindClause Bool contains p = do d <- filePath return $ unsafePerformIO $ - E.handle (const (return False)) $ + handle (\(_::IOException) -> return False) $ F.getFileStatus (d p) >> return True -- | Lift a binary operator into the 'FindClause' monad, so that it diff --git a/System/FilePath/Glob.hs b/System/FilePath/Glob.hs index 0164608..1a31c63 100644 --- a/System/FilePath/Glob.hs +++ b/System/FilePath/Glob.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module: System.FilePath.Glob -- Copyright: Bryan O'Sullivan @@ -10,6 +11,7 @@ module System.FilePath.Glob ( namesMatching ) where +import Control.Exception import Control.Monad (forM) import System.FilePath.GlobPattern ((~~)) import System.Directory (doesDirectoryExist, doesFileExist, @@ -17,8 +19,6 @@ import System.Directory (doesDirectoryExist, doesFileExist, import System.FilePath (dropTrailingPathSeparator, splitFileName, ()) import System.IO.Unsafe (unsafeInterleaveIO) -import System.FilePath.Error (handle) - -- | Return a list of names matching a glob pattern. The list is -- generated lazily. namesMatching :: String -> IO [FilePath] @@ -49,7 +49,7 @@ listMatches dirName pat = do dirName' <- if null dirName then getCurrentDirectory else return dirName - names <- unsafeInterleaveIO (handle (const (return [])) $ + names <- unsafeInterleaveIO (handle (\(_::IOException) -> return []) $ getDirectoryContents dirName') let names' = if isHidden pat then filter isHidden names diff --git a/System/FilePath/Manip.hs b/System/FilePath/Manip.hs index 2dad4a9..a8019c0 100644 --- a/System/FilePath/Manip.hs +++ b/System/FilePath/Manip.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-} -- | -- Module: System.FilePath.Manip @@ -16,8 +16,7 @@ module System.FilePath.Manip ( , modifyInPlace ) where -import System.FilePath.Error (bracket, bracket_, handle, throwIO) - +import Control.Exception import Control.Monad (liftM) import Data.Bits ((.&.)) import System.Directory (removeFile) @@ -104,11 +103,11 @@ modifyWith after transform path = bracket (openFile path ReadMode) hClose $ \ih -> do (tmpPath, oh) <- mkstemp (path ++ "XXXXXX") let ignore = return () - nukeTmp = handle (const ignore) (removeFile tmpPath) - handle (\e -> nukeTmp >> throwIO e) $ do + nukeTmp = handle (\(_::IOException) -> ignore) (removeFile tmpPath) + handle (\(e::IOException) -> nukeTmp >> throw e) $ do bracket_ ignore (hClose oh) $ readAll ih >>= return . transform >>= writeAll oh - handle (const nukeTmp) $ do + handle (\(_::IOException) -> nukeTmp) $ do mode <- fileMode `liftM` getFileStatus path setFileMode tmpPath (mode .&. 0777) after path tmpPath diff --git a/filemanip.cabal b/filemanip.cabal index 64ed0cf..481eb65 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -1,5 +1,5 @@ Name: filemanip -Version: 0.4.0.0 +Version: 0.3.5.0 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan @@ -15,12 +15,16 @@ Build-type: Simple Extra-Source-Files: README.markdown Library - + build-depends: base < 5, bytestring, directory, filepath, mtl, unix-compat + if !os(windows) + build-depends: unix + if impl(ghc >= 6.10) + build-depends: + base >= 4 + GHC-Options: -Wall Exposed-Modules: System.FilePath.Find, System.FilePath.Glob, System.FilePath.GlobPattern, System.FilePath.Manip - Other-Modules: - System.FilePath.Error From 0bce865d1e4e1fb1fe15cb8556221b7d3fa74352 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 10 Oct 2010 16:17:07 -0700 Subject: [PATCH 46/67] Added tag 0.3.5.0 for changeset 64cd3627a707 --- .hgtags | 1 + 1 file changed, 1 insertion(+) diff --git a/.hgtags b/.hgtags index b94f031..070e7f6 100644 --- a/.hgtags +++ b/.hgtags @@ -1 +1,2 @@ f76fcbbbfead7acb4d8323fb230155f06d2aad5b 0.3.3 +64cd3627a7075b9d49ec0a0f4c8eca7f72588015 0.3.5.0 From 5b0239278d9f25466b62a32acab97886419c558d Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 1 Nov 2010 21:21:12 -0700 Subject: [PATCH 47/67] Fix dependency on mtl --- filemanip.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/filemanip.cabal b/filemanip.cabal index 481eb65..7fb9bcb 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -1,5 +1,5 @@ Name: filemanip -Version: 0.3.5.0 +Version: 0.3.5.1 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan @@ -15,7 +15,7 @@ Build-type: Simple Extra-Source-Files: README.markdown Library - build-depends: base < 5, bytestring, directory, filepath, mtl, unix-compat + build-depends: base < 5, bytestring, directory, filepath, mtl == 1.1.*, unix-compat if !os(windows) build-depends: unix if impl(ghc >= 6.10) From 3e57adf369548276a0febd3e3f0be31f4914fa19 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Mon, 1 Nov 2010 21:21:43 -0700 Subject: [PATCH 48/67] Added tag 0.3.5.1 for changeset 072c321a639d --- .hgtags | 1 + 1 file changed, 1 insertion(+) diff --git a/.hgtags b/.hgtags index 070e7f6..88473c5 100644 --- a/.hgtags +++ b/.hgtags @@ -1,2 +1,3 @@ f76fcbbbfead7acb4d8323fb230155f06d2aad5b 0.3.3 64cd3627a7075b9d49ec0a0f4c8eca7f72588015 0.3.5.0 +072c321a639de2c184f4c14337d8e817ab459873 0.3.5.1 From 72da48644f6cd479b2168702aff13b019196f2d0 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Tue, 8 Feb 2011 13:44:01 -0800 Subject: [PATCH 49/67] Get working with newer mtl (and GHC 7) --- System/FilePath/Find.hs | 7 ++----- filemanip.cabal | 12 ++++++++++-- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index b66ff55..0f7244d 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -113,7 +113,7 @@ module System.FilePath.Find ( import Control.Exception import Control.Monad (foldM, forM, liftM, liftM2) -import Control.Monad.State (State(..), evalState) +import Control.Monad.State (State, evalState, get) import Data.Bits (Bits, (.&.)) import Data.List (sort) import System.Directory (getDirectoryContents) @@ -172,13 +172,10 @@ evalFI :: FindClause a -> a evalFI m p d s = evalClause m (mkFI p d s) -mkFindClause :: (FileInfo -> (a, FileInfo)) -> FindClause a -mkFindClause = FC . State - -- | Return the current 'FileInfo'. fileInfo :: FindClause FileInfo -fileInfo = mkFindClause $ \st -> (st, st) +fileInfo = FC $ get -- | Return the name of the file being visited. filePath :: FindClause FilePath diff --git a/filemanip.cabal b/filemanip.cabal index 7fb9bcb..0898903 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -1,5 +1,5 @@ Name: filemanip -Version: 0.3.5.1 +Version: 0.3.5.2 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan @@ -15,7 +15,7 @@ Build-type: Simple Extra-Source-Files: README.markdown Library - build-depends: base < 5, bytestring, directory, filepath, mtl == 1.1.*, unix-compat + build-depends: base < 5, bytestring, directory, filepath, mtl, unix-compat if !os(windows) build-depends: unix if impl(ghc >= 6.10) @@ -28,3 +28,11 @@ Library System.FilePath.Glob, System.FilePath.GlobPattern, System.FilePath.Manip + +source-repository head + type: mercurial + location: http://bitbucket.org/bos/filemanip + +source-repository head + type: git + location: http://github.com/bos/filemanip From e17849e1deb65680741cd8c0f86dfc394ae2cc5b Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Tue, 8 Feb 2011 13:46:06 -0800 Subject: [PATCH 50/67] Add bug report and homepage links --- filemanip.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/filemanip.cabal b/filemanip.cabal index 0898903..f2aa94f 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -4,6 +4,8 @@ License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan Maintainer: Bryan O'Sullivan +Homepage: http://bitbucket.org/bos/filemanip +Bug-reports: http://bitbucket.org/bos/filemanip/issues Synopsis: Expressive file and directory manipulation for Haskell. Category: System Description: A Haskell library for working with files and directories. From acb9d13766c39ecf4f85b9aa35a0c385768b7b22 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Tue, 8 Feb 2011 13:46:09 -0800 Subject: [PATCH 51/67] Added tag 0.3.5.2 for changeset 26a8ade60b05 --- .hgtags | 1 + 1 file changed, 1 insertion(+) diff --git a/.hgtags b/.hgtags index 88473c5..90cbbcd 100644 --- a/.hgtags +++ b/.hgtags @@ -1,3 +1,4 @@ f76fcbbbfead7acb4d8323fb230155f06d2aad5b 0.3.3 64cd3627a7075b9d49ec0a0f4c8eca7f72588015 0.3.5.0 072c321a639de2c184f4c14337d8e817ab459873 0.3.5.1 +26a8ade60b05e19a8a169aaddd4f06ec029247c6 0.3.5.2 From 5d7c44c690643b35d7981b8667a17cd5e47df97b Mon Sep 17 00:00:00 2001 From: Jacob Stanley Date: Mon, 7 Nov 2011 10:16:43 +0800 Subject: [PATCH 52/67] Use System.PosixCompat instead of System.Posix This uses the unix-compat wrappers instead of unix directly so that the functionality can be emulated on Windows. --- System/FilePath/Manip.hs | 4 ++-- filemanip.cabal | 2 -- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/System/FilePath/Manip.hs b/System/FilePath/Manip.hs index a8019c0..82c601b 100644 --- a/System/FilePath/Manip.hs +++ b/System/FilePath/Manip.hs @@ -21,8 +21,8 @@ import Control.Monad (liftM) import Data.Bits ((.&.)) import System.Directory (removeFile) import System.IO (Handle, IOMode(..), hClose, openFile) -import System.Posix.Files (fileMode, getFileStatus, rename, setFileMode) -import System.Posix.Temp (mkstemp) +import System.PosixCompat.Files (fileMode, getFileStatus, rename, setFileMode) +import System.PosixCompat.Temp (mkstemp) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified System.IO as I diff --git a/filemanip.cabal b/filemanip.cabal index f2aa94f..bebefbf 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -18,8 +18,6 @@ Extra-Source-Files: README.markdown Library build-depends: base < 5, bytestring, directory, filepath, mtl, unix-compat - if !os(windows) - build-depends: unix if impl(ghc >= 6.10) build-depends: base >= 4 From 342a04bf7d0f5b20a1c211eea056ac2c9c3071dc Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 13 Nov 2011 19:24:59 -0800 Subject: [PATCH 53/67] Update URLs --- README.markdown | 12 ++++++------ filemanip.cabal | 12 ++++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/README.markdown b/README.markdown index f0e49fd..62ea015 100644 --- a/README.markdown +++ b/README.markdown @@ -7,16 +7,16 @@ matching, and manipulating files. # Get involved! Please report bugs via the -[bitbucket issue tracker](http://bitbucket.org/bos/attoparsec/filemanip). +[github issue tracker](https://github.com/bos/filemanip/issues). -Master [Mercurial repository](http://bitbucket.org/bos/filemanip): - -* `hg clone http://bitbucket.org/bos/filemanip` - -There's also a [git mirror](http://github.com/bos/filemanip): +Master [git repository](http://github.com/bos/filemanip): * `git clone git://github.com/bos/filemanip.git` +There's also a [Mercurial mirror](http://bitbucket.org/bos/filemanip): + +* `hg clone https://bitbucket.org/bos/filemanip` + (You can create and contribute changes using either Mercurial or git.) diff --git a/filemanip.cabal b/filemanip.cabal index f2aa94f..146b332 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -4,8 +4,8 @@ License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan Maintainer: Bryan O'Sullivan -Homepage: http://bitbucket.org/bos/filemanip -Bug-reports: http://bitbucket.org/bos/filemanip/issues +Homepage: https://github.com/bos/filemanip +Bug-reports: https://github.com/bos/filemanip/issues Synopsis: Expressive file and directory manipulation for Haskell. Category: System Description: A Haskell library for working with files and directories. @@ -32,9 +32,9 @@ Library System.FilePath.Manip source-repository head - type: mercurial - location: http://bitbucket.org/bos/filemanip + type: git + location: git://github.com/bos/filemanip.git source-repository head - type: git - location: http://github.com/bos/filemanip + type: mercurial + location: https://bitbucket.org/bos/filemanip From 2108b0cb3ce293c1e948eeeeb92dd738143d7f16 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 13 Nov 2011 19:36:48 -0800 Subject: [PATCH 54/67] Bump version to 0.3.6.0 --- filemanip.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/filemanip.cabal b/filemanip.cabal index fe6b825..9b600a9 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -1,5 +1,5 @@ Name: filemanip -Version: 0.3.5.2 +Version: 0.3.6.0 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan From 9eb58d22f165ca72040596f2aec76912df956d72 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 13 Nov 2011 19:36:56 -0800 Subject: [PATCH 55/67] Added tag 0.3.6.0 for changeset ffce91ed40c6 --- .hgtags | 1 + 1 file changed, 1 insertion(+) diff --git a/.hgtags b/.hgtags index 90cbbcd..c33827e 100644 --- a/.hgtags +++ b/.hgtags @@ -2,3 +2,4 @@ f76fcbbbfead7acb4d8323fb230155f06d2aad5b 0.3.3 64cd3627a7075b9d49ec0a0f4c8eca7f72588015 0.3.5.0 072c321a639de2c184f4c14337d8e817ab459873 0.3.5.1 26a8ade60b05e19a8a169aaddd4f06ec029247c6 0.3.5.2 +ffce91ed40c677b6f3bfede29542db7995f25b1b 0.3.6.0 From 213cefa832ba19db4d41dc5c2f89634682b735fe Mon Sep 17 00:00:00 2001 From: Erik Hesselink Date: Tue, 17 Apr 2012 14:02:05 +0200 Subject: [PATCH 56/67] Remove infinite loop on MatchGroup without common prefix. In that case, the exact same MatchGroup would be fed to simplifyTerms again. Now, it is returned immediately, and only the rest of the terms are simplified. --- System/FilePath/GlobPattern.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/System/FilePath/GlobPattern.hs b/System/FilePath/GlobPattern.hs index 7299de0..91b1f09 100644 --- a/System/FilePath/GlobPattern.hs +++ b/System/FilePath/GlobPattern.hs @@ -117,8 +117,9 @@ simplifyTerms (MatchClass True (SRange a@[_] []):as) = simplifyTerms (MatchGroup []:as) = simplifyTerms as simplifyTerms (MatchGroup gs:as) = case commonPrefix gs of - (p,[]) -> simplifyTerms (MatchLiteral p : as) - (p,ss) -> simplifyTerms (MatchLiteral p : MatchGroup ss : as) + (p ,[]) -> simplifyTerms (MatchLiteral p : as) + ("",ss) -> MatchGroup ss : simplifyTerms as + (p ,ss) -> simplifyTerms (MatchLiteral p : MatchGroup ss : as) simplifyTerms (a:as) = a:simplifyTerms as commonPrefix :: [String] -> (String, [String]) From 0fb804cc212306d935dd5657e154d8db629d60bc Mon Sep 17 00:00:00 2001 From: Erik Hesselink Date: Tue, 17 Apr 2012 15:33:44 +0200 Subject: [PATCH 57/67] Fixed matching of groups. Matching of the tail of all groups would continue if any matched, leading to (aa|bb) matching the string ab. Also, any empty group would mean continuing to match the rest of the terms, ignoring a non-empty matching group. This lead to (aa|a) not matching the string a. --- System/FilePath/GlobPattern.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/System/FilePath/GlobPattern.hs b/System/FilePath/GlobPattern.hs index 91b1f09..37af02a 100644 --- a/System/FilePath/GlobPattern.hs +++ b/System/FilePath/GlobPattern.hs @@ -15,6 +15,7 @@ module System.FilePath.GlobPattern ( ) where import Control.Arrow (second) +import Control.Monad (msum) import Data.Ix (Ix, inRange) import Data.List (nub) import Data.Maybe (isJust) @@ -144,11 +145,8 @@ matchTerms (MatchClass k c:ts) cs = matchClass cs >>= matchTerms ts where matchClass (b:bs) | (inClass && k) || not (inClass || k) = return bs where inClass = b `inSRange` c matchClass _ = fail "no match" -matchTerms (MatchGroup g:ts) cs = matchGroup g cs >>= matchTerms ts - where matchGroup g' as | any null g' = return as - matchGroup g' (a:as) | a `elem` map head g' = - matchGroup (map tail g') as - matchGroup _ _ = fail "not in group" +matchTerms (MatchGroup g:ts) cs = msum (map matchGroup g) + where matchGroup g = matchTerms (MatchLiteral g : ts) cs matchTerms [MatchAny] _ = return () matchTerms (MatchAny:ts) cs = matchAny cs >>= matchTerms ts where matchAny [] = fail "no match" From 604d1aded855630f03fcc2d781acb3f711da3ec8 Mon Sep 17 00:00:00 2001 From: Erik Hesselink Date: Tue, 17 Apr 2012 14:06:52 +0200 Subject: [PATCH 58/67] Bump version to 0.3.6.1. --- filemanip.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/filemanip.cabal b/filemanip.cabal index 9b600a9..6403417 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -1,5 +1,5 @@ Name: filemanip -Version: 0.3.6.0 +Version: 0.3.6.1 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan From d7cd17287a93e9e7f2360b4cbc96b4e4057343a0 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Wed, 29 Aug 2012 20:12:51 -0700 Subject: [PATCH 59/67] Fix GHC 7.6 build problems --- System/FilePath/Find.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 0f7244d..2af3bd6 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -111,7 +111,8 @@ module System.FilePath.Find ( , (||?) ) where -import Control.Exception +import qualified Control.Exception as E +import Control.Exception (IOException, handle) import Control.Monad (foldM, forM, liftM, liftM2) import Control.Monad.State (State, evalState, get) import Data.Bits (Bits, (.&.)) @@ -123,7 +124,6 @@ import System.IO (hPutStrLn, stderr) import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) import qualified System.PosixCompat.Files as F import qualified System.PosixCompat.Types as T -import Prelude hiding (catch) -- | Information collected during the traversal of a directory. data FileInfo = FileInfo @@ -222,7 +222,7 @@ findWithHandler errHandler recurse filt path0 = then unsafeInterleaveIO (traverse path (succ depth) st) else filterPath path depth st [] traverse dir depth dirSt = do - names <- catch (getDirContents dir) (errHandler dir) + names <- E.catch (getDirContents dir) (errHandler dir) filteredPaths <- forM names $ \name -> do let path = dir name unsafeInterleaveIO $ handle (errHandler path) From 7237db6264d0edaca200cd73bade6e1132cce76d Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Wed, 29 Aug 2012 20:13:11 -0700 Subject: [PATCH 60/67] Bump version to 0.3.6.1 --- filemanip.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/filemanip.cabal b/filemanip.cabal index 9b600a9..6403417 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -1,5 +1,5 @@ Name: filemanip -Version: 0.3.6.0 +Version: 0.3.6.1 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan From f203c1a2959efe8328ef48ca9a678ec2ea698863 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Wed, 29 Aug 2012 20:13:15 -0700 Subject: [PATCH 61/67] Added tag 0.3.6.1 for changeset 4c6a1170cb18 --- .hgtags | 1 + 1 file changed, 1 insertion(+) diff --git a/.hgtags b/.hgtags index c33827e..280e3d0 100644 --- a/.hgtags +++ b/.hgtags @@ -3,3 +3,4 @@ f76fcbbbfead7acb4d8323fb230155f06d2aad5b 0.3.3 072c321a639de2c184f4c14337d8e817ab459873 0.3.5.1 26a8ade60b05e19a8a169aaddd4f06ec029247c6 0.3.5.2 ffce91ed40c677b6f3bfede29542db7995f25b1b 0.3.6.0 +4c6a1170cb189038b63d9f7e1e7e43aa1aa372f2 0.3.6.1 From f86debf3c1dcac2ff0e7c0d9c3ba12e7449d8a38 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 9 Sep 2012 00:05:32 -0700 Subject: [PATCH 62/67] Bump version to 0.3.6.2 --- filemanip.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/filemanip.cabal b/filemanip.cabal index 6403417..3d53e8f 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -1,5 +1,5 @@ Name: filemanip -Version: 0.3.6.1 +Version: 0.3.6.2 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan From d5f8dfac0b8e679a7a06bcf82165f6524886bbb7 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 9 Sep 2012 00:05:36 -0700 Subject: [PATCH 63/67] Added tag 0.3.6.2 for changeset 72891e0e9706 --- .hgtags | 1 + 1 file changed, 1 insertion(+) diff --git a/.hgtags b/.hgtags index 280e3d0..8aeff47 100644 --- a/.hgtags +++ b/.hgtags @@ -4,3 +4,4 @@ f76fcbbbfead7acb4d8323fb230155f06d2aad5b 0.3.3 26a8ade60b05e19a8a169aaddd4f06ec029247c6 0.3.5.2 ffce91ed40c677b6f3bfede29542db7995f25b1b 0.3.6.0 4c6a1170cb189038b63d9f7e1e7e43aa1aa372f2 0.3.6.1 +72891e0e97065c6ec6753cc44618d36a0ea7f5de 0.3.6.2 From c48442dbfe7a4e73d57c0a23ff56b38bed5905f1 Mon Sep 17 00:00:00 2001 From: Mihaly Barasz Date: Sat, 5 Apr 2014 22:26:53 +0200 Subject: [PATCH 64/67] Add canonicalPath and canonicalName combinators --- System/FilePath/Find.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 2af3bd6..4779cd0 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -90,6 +90,10 @@ module System.FilePath.Find ( , filePerms , anyPerms + -- ** Combinators for canonical path and name + , canonicalPath + , canonicalName + -- ** Combinators that operate on symbolic links , readLink , followStatus @@ -117,7 +121,7 @@ import Control.Monad (foldM, forM, liftM, liftM2) import Control.Monad.State (State, evalState, get) import Data.Bits (Bits, (.&.)) import Data.List (sort) -import System.Directory (getDirectoryContents) +import System.Directory (getDirectoryContents, canonicalizePath) import System.FilePath ((), takeDirectory, takeExtension, takeFileName) import System.FilePath.GlobPattern (GlobPattern, (~~), (/~)) import System.IO (hPutStrLn, stderr) @@ -341,6 +345,17 @@ fileName = takeFileName `liftM` filePath directory :: FindClause FilePath directory = takeDirectory `liftM` filePath +-- | Return the canonical path of the file being visited. +-- +-- See `canonicalizePath` for details of what canonical path means. +canonicalPath :: FindClause FilePath +canonicalPath = (unsafePerformIO . canonicalizePath) `liftM` filePath + +-- | Return the canonical name of the file (canonical path with the +-- directory part removed). +canonicalName :: FindClause FilePath +canonicalName = takeFileName `liftM` canonicalPath + -- | 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. From e9b48a2604b30b505dadefc22e161aff2825ea2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Sicard-Ram=C3=ADrez?= Date: Thu, 12 Jun 2014 14:48:38 -0500 Subject: [PATCH 65/67] Fixed documentation in Find.hs --- System/FilePath/Find.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 2af3bd6..73a93b3 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -29,7 +29,7 @@ -- 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 +-- Here's a clause that will return 'True' for any file whose -- directory name contains the word @\"temp\"@. -- -- @ From cefca01267a3ca82d61f1e7ea95aa202fda0bbd4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Sicard-Ram=C3=ADrez?= Date: Thu, 12 Jun 2014 17:47:35 -0500 Subject: [PATCH 66/67] Fixed buggy example noRCS --- examples/Simple.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Simple.hs b/examples/Simple.hs index b49fc9c..850571f 100644 --- a/examples/Simple.hs +++ b/examples/Simple.hs @@ -33,7 +33,7 @@ renameCppToC path = find always (extension ==? ".cpp") path >>= noRCS :: RecursionPredicate -noRCS = (`elem` ["_darcs","SCCS","CVS",".svn",".hg",".git"]) `liftM` fileName +noRCS = (`notElem` ["_darcs","SCCS","CVS",".svn",".hg",".git"]) `liftM` fileName cSources :: FilePath -> IO [FilePath] From b1120a32535383c7f72728e272fe19a7715661a3 Mon Sep 17 00:00:00 2001 From: Georges Dubus Date: Sun, 28 Dec 2014 22:56:27 +0100 Subject: [PATCH 67/67] Fixed a typo that broke the "**" pattern. Fixes #5 --- System/FilePath/GlobPattern.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/System/FilePath/GlobPattern.hs b/System/FilePath/GlobPattern.hs index 37af02a..53903ac 100644 --- a/System/FilePath/GlobPattern.hs +++ b/System/FilePath/GlobPattern.hs @@ -152,7 +152,7 @@ matchTerms (MatchAny:ts) cs = matchAny cs >>= matchTerms ts where matchAny [] = fail "no match" matchAny cs' = case matchTerms ts cs' of Nothing -> matchAny (tail cs') - _ -> return cs + _ -> return cs' matchTerms [MatchDir] cs | pathSeparator `elem` cs = fail "path separator" | otherwise = return () matchTerms (MatchDir:ts) cs = matchDir cs >>= matchTerms ts