Glob 0.1 → 0.2
raw patch · 3 files changed
+70/−37 lines, 3 filesdep +dlistPVP ok
version bump matches the API change (PVP)
Dependencies added: dlist
API changes (from Hackage documentation)
Files
- Glob.cabal +2/−1
- System/FilePath/Glob/Directory.hs +22/−16
- System/FilePath/Glob/Utils.hs +46/−20
Glob.cabal view
@@ -1,7 +1,7 @@ Cabal-Version: >= 1.2 Name: Glob-Version: 0.1+Version: 0.2 Homepage: http://iki.fi/matti.niemenmaa/glob/ Synopsis: Globbing library Category: System@@ -24,6 +24,7 @@ Build-Depends: base >= 3 && < 5 , containers == 0.* , directory == 1.*+ , dlist == 0.* , filepath == 1.* , mtl == 1.*
System/FilePath/Glob/Directory.hs view
@@ -3,13 +3,16 @@ module System.FilePath.Glob.Directory (globDir) where import Control.Monad (forM)+import qualified Data.DList as DL+import Data.DList (DList) import Data.List ((\\), partition) import System.Directory (doesDirectoryExist, getDirectoryContents) import System.FilePath ((</>)) import System.FilePath.Glob.Base import System.FilePath.Glob.Match (match)-import System.FilePath.Glob.Utils (getRecursiveContents, nubOrd, pathParts)+import System.FilePath.Glob.Utils+ (getRecursiveContents, nubOrd, pathParts, partitionDL) -- The Patterns in TypedPattern don't contain PathSeparator or AnyDirectory data TypedPattern@@ -42,10 +45,15 @@ results <- mapM (\p -> globDir' (separate p) dir) pats let (matches, others) = unzip results+ allMatches = DL.toList . DL.concat $ matches+ allOthers = DL.toList . DL.concat $ others - return (matches, nubOrd (concat others) \\ concat matches)+ return ( map DL.toList matches+ , nubOrd allOthers \\ allMatches+ ) -globDir' :: [TypedPattern] -> FilePath -> IO ([FilePath], [FilePath])+globDir' :: [TypedPattern] -> FilePath -> IO (DList FilePath, DList FilePath)+globDir' [] _ = return (DL.empty, DL.empty) globDir' pats dir = do raw <- getDirectoryContents dir @@ -55,18 +63,16 @@ let (matches, others) = unzip results - return (concat matches, concat others)+ return (DL.concat matches, DL.concat others) matchTypedAndGo :: [TypedPattern] -> FilePath -> FilePath- -> IO ([FilePath], [FilePath])--matchTypedAndGo [] _ _ = return ([], [])+ -> IO (DList FilePath, DList FilePath) -- (Any p) is always the last element matchTypedAndGo [Any p] path absPath = if match p path- then return ([absPath], [])+ then return (DL.singleton absPath, DL.empty) else doesDirectoryExist absPath >>= didn'tMatch absPath matchTypedAndGo (Dir p:ps) path absPath = do@@ -77,21 +83,21 @@ matchTypedAndGo (AnyDir p:ps) path absPath = do isDir <- doesDirectoryExist absPath- let pat = unseparate ps+ let m = match (unseparate ps) case null (unPattern p) || match p path of- True | isDir -> fmap (partition (any (match pat) . pathParts))- (getRecursiveContents absPath)- True | match pat path -> return ([absPath], [])- _ -> didn'tMatch absPath isDir+ True | isDir -> fmap (partitionDL (any m . pathParts))+ (getRecursiveContents absPath)+ True | m path -> return (DL.singleton absPath, DL.empty)+ _ -> didn'tMatch absPath isDir matchTypedAndGo _ _ _ = error "Glob.matchTypedAndGo :: internal error" -didn'tMatch :: FilePath -> Bool -> IO ([FilePath], [FilePath])-didn'tMatch absPath isDir = (fmap $ (,) []) $+didn'tMatch :: FilePath -> Bool -> IO (DList FilePath, DList FilePath)+didn'tMatch absPath isDir = (fmap $ (,) DL.empty) $ if isDir then getRecursiveContents absPath- else return [absPath]+ else return$ DL.singleton absPath separate :: Pattern -> [TypedPattern] separate = go [] . unPattern
System/FilePath/Glob/Utils.hs view
@@ -1,11 +1,23 @@ -- File created: 2008-10-10 13:40:35 -module System.FilePath.Glob.Utils where+module System.FilePath.Glob.Utils+ ( isLeft, fromLeft+ , increasingSeq+ , addToRange, inRange, overlap+ , dropLeadingZeroes+ , pathParts+ , nubOrd+ , partitionDL+ , getRecursiveContents+ ) where -import Data.List ((\\), tails)+import Control.Monad (foldM)+import Data.List ((\\))+import qualified Data.DList as DL+import Data.DList (DList) import qualified Data.Set as Set import System.Directory (doesDirectoryExist, getDirectoryContents)-import System.FilePath ((</>), joinPath, splitPath)+import System.FilePath ((</>), isPathSeparator, dropDrive) import System.IO.Unsafe (unsafeInterleaveIO) inRange :: Ord a => (a,a) -> a -> Bool@@ -62,33 +74,47 @@ let x = dropWhile (=='0') s in if null x then "0" else x +-- foo/bar/baz -> [foo/bar/baz,bar/baz,baz] pathParts :: FilePath -> [FilePath]-pathParts = map joinPath . tails . splitPath+pathParts p = p : let d = dropDrive p+ in if null d || d == p+ then f d+ else d : f d+ where+ f [] = []+ f (x:xs@(y:_)) | isPathSeparator x && isPathSeparator y = f xs+ f (x:xs) =+ if isPathSeparator x+ then xs : f xs+ else f xs -getRecursiveContents :: FilePath -> IO [FilePath]-getRecursiveContents dir = flip catch (const $ return []) $ do+getRecursiveContents :: FilePath -> IO (DList FilePath)+getRecursiveContents dir = do raw <- getDirectoryContents dir - let entries = raw \\ [".",".."]- absEntries =- if dir == "."- then entries- else map (dir </>) entries+ let entries = map (dir </>) (raw \\ [".",".."]) - (dirs,files) <- partitionM doesDirectoryExist absEntries+ (dirs,files) <- partitionM doesDirectoryExist entries subs <- unsafeInterleaveIO . mapM getRecursiveContents $ dirs - return$ dir : files ++ concat subs+ return$ DL.cons dir (DL.fromList files `DL.append` DL.concat subs) partitionM :: (Monad m) => (a -> m Bool) -> [a] -> m ([a], [a])-partitionM _ [] = return ([],[])-partitionM p (x:xs) = do- ~(ts,fs) <- partitionM p xs- b <- p x- return $ if b- then (x:ts, fs)- else (ts, x:fs)+partitionM p_ = foldM (f p_) ([],[])+ where+ f p (ts,fs) x = p x >>= \b ->+ if b+ then return (x:ts, fs)+ else return (ts, x:fs)++partitionDL :: (a -> Bool) -> DList a -> (DList a, DList a)+partitionDL p_ = DL.foldr (f p_) (DL.empty,DL.empty)+ where+ f p x (ts,fs) =+ if p x+ then (DL.cons x ts, fs)+ else (ts, DL.cons x fs) nubOrd :: Ord a => [a] -> [a] nubOrd = go Set.empty