diff --git a/CHANGELOG.txt b/CHANGELOG.txt --- a/CHANGELOG.txt +++ b/CHANGELOG.txt @@ -1,3 +1,15 @@ +0.6, 2011-09-12: + New functions: + System.FilePath.Glob.glob :: Pattern -> IO [FilePath] + + Change: globDir, given a Pattern starting with a path separator, now ignores + the given directory. Thus e.g. globDir (compile "/*") d gives the + contents of "/" regardless of the value of d. + + Thanks to Max Bolingbroke for the feature request. + + Changed dependency on mtl to transformers. + 0.5.1, 2010-11-23: Update dependencies to allow for mtl 2.0. diff --git a/Glob.cabal b/Glob.cabal --- a/Glob.cabal +++ b/Glob.cabal @@ -1,7 +1,7 @@ Cabal-Version: >= 1.6 Name: Glob -Version: 0.5.1 +Version: 0.6 Homepage: http://iki.fi/matti.niemenmaa/glob/ Synopsis: Globbing library Category: System @@ -23,12 +23,12 @@ tests/Tests/*.hs Library - Build-Depends: base >= 3 && < 5 - , containers == 0.* - , directory == 1.* - , dlist == 0.* - , filepath == 1.* - , mtl >= 1.1 && < 2.1 + Build-Depends: base >= 3 && < 5 + , containers == 0.* + , directory == 1.* + , dlist == 0.* + , filepath == 1.* + , transformers == 0.2.* if os(windows) Build-Depends: Win32 == 2.* diff --git a/LICENSE.txt b/LICENSE.txt --- a/LICENSE.txt +++ b/LICENSE.txt @@ -2,7 +2,7 @@ the code are held by whoever wrote the code in question: see CREDITS.txt for a list of authors. -Copyright (c) 2008-2010 +Copyright (c) 2008-2011 All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/System/FilePath/Glob.hs b/System/FilePath/Glob.hs --- a/System/FilePath/Glob.hs +++ b/System/FilePath/Glob.hs @@ -18,7 +18,7 @@ , compDefault, compPosix -- ** Matching , match - , globDir, globDir1 + , globDir, globDir1, glob -- *** Options , MatchOptions(..) , matchWith @@ -36,7 +36,7 @@ , compile, compileWith, tryCompileWith , decompile ) -import System.FilePath.Glob.Directory ( globDir, globDirWith, globDir1 +import System.FilePath.Glob.Directory ( globDir, globDirWith, globDir1, glob , commonDirectory ) import System.FilePath.Glob.Match (match, matchWith) diff --git a/System/FilePath/Glob/Base.hs b/System/FilePath/Glob/Base.hs --- a/System/FilePath/Glob/Base.hs +++ b/System/FilePath/Glob/Base.hs @@ -19,17 +19,18 @@ , liftP, tokToLower ) where -import Control.Arrow (first) -import Control.Monad.Error (ErrorT, runErrorT, throwError) -import Control.Monad.Writer.Strict (Writer, runWriter, tell) -import Control.Exception (assert) -import Data.Char (isDigit, isAlpha, toLower) -import Data.List (find, sortBy) -import Data.Maybe (fromMaybe) -import Data.Monoid (Monoid, mappend, mempty, mconcat) -import System.FilePath ( pathSeparator, extSeparator - , isExtSeparator, isPathSeparator - ) +import Control.Arrow (first) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Error (ErrorT, runErrorT, throwError) +import Control.Monad.Trans.Writer.Strict (Writer, runWriter, tell) +import Control.Exception (assert) +import Data.Char (isDigit, isAlpha, toLower) +import Data.List (find, sortBy) +import Data.Maybe (fromMaybe) +import Data.Monoid (Monoid, mappend, mempty, mconcat) +import System.FilePath ( pathSeparator, extSeparator + , isExtSeparator, isPathSeparator + ) import System.FilePath.Glob.Utils ( dropLeadingZeroes , isLeft, fromLeft @@ -451,16 +452,16 @@ char :: Char -> String -> ErrorT String (Writer CharRange) String char c ('-':x:xs) = if x == ']' - then tell [Left c, Left '-'] >> return xs - else tell [Right (c,x)] >> go xs + then ltell [Left c, Left '-'] >> return xs + else ltell [Right (c,x)] >> go xs - char c xs = tell [Left c] >> go xs + char c xs = ltell [Left c] >> go xs readClass :: String -> ErrorT String (Writer CharRange) String readClass xs = let (name,end) = span isAlpha xs in case end of - ':':']':rest -> charClass name >> go rest - _ -> tell [Left '[',Left ':'] >> go xs + ':':']':rest -> charClass name >> go rest + _ -> ltell [Left '[',Left ':'] >> go xs charClass :: String -> ErrorT String (Writer CharRange) () charClass name = @@ -469,18 +470,18 @@ -- TODO: this is ASCII-only, not sure how this should be extended -- Unicode, or with a locale as input, or something else? case name of - "alnum" -> tell [digit,upper,lower] - "alpha" -> tell [upper,lower] - "blank" -> tell blanks - "cntrl" -> tell [Right ('\0','\x1f'), Left '\x7f'] - "digit" -> tell [digit] - "graph" -> tell [Right ('!','~')] - "lower" -> tell [lower] - "print" -> tell [Right (' ','~')] - "punct" -> tell punct - "space" -> tell spaces - "upper" -> tell [upper] - "xdigit" -> tell [digit, Right ('A','F'), Right ('a','f')] + "alnum" -> ltell [digit,upper,lower] + "alpha" -> ltell [upper,lower] + "blank" -> ltell blanks + "cntrl" -> ltell [Right ('\0','\x1f'), Left '\x7f'] + "digit" -> ltell [digit] + "graph" -> ltell [Right ('!','~')] + "lower" -> ltell [lower] + "print" -> ltell [Right (' ','~')] + "punct" -> ltell punct + "space" -> ltell spaces + "upper" -> ltell [upper] + "xdigit" -> ltell [digit, Right ('A','F'), Right ('a','f')] _ -> throwError ("compile :: unknown character class '" ++name++ "'") @@ -490,6 +491,8 @@ punct = map Right [('!','/'), (':','@'), ('[','`'), ('{','~')] blanks = [Left '\t', Left ' '] spaces = [Right ('\t','\r'), Left ' '] + + ltell = lift . tell ------------------------------------------ diff --git a/System/FilePath/Glob/Directory.hs b/System/FilePath/Glob/Directory.hs --- a/System/FilePath/Glob/Directory.hs +++ b/System/FilePath/Glob/Directory.hs @@ -1,7 +1,7 @@ -- File created: 2008-10-16 12:12:50 module System.FilePath.Glob.Directory - ( globDir, globDirWith, globDir1 + ( globDir, globDirWith, globDir1, glob , commonDirectory ) where @@ -10,12 +10,15 @@ import qualified Data.DList as DL import Data.DList (DList) import Data.List ((\\)) +import Data.Maybe (listToMaybe) import System.Directory ( doesDirectoryExist, getDirectoryContents , getCurrentDirectory ) -import System.FilePath ((), extSeparator, isExtSeparator, pathSeparator) +import System.FilePath ( (), extSeparator, isExtSeparator, pathSeparator + , takeDrive + ) -import System.FilePath.Glob.Base ( Pattern(..), Token(..) +import System.FilePath.Glob.Base ( Pattern(..), Token(..), liftP , MatchOptions, matchDefault ) import System.FilePath.Glob.Match (matchWith) @@ -64,6 +67,9 @@ -- -- If the given 'FilePath' is @[]@, 'getCurrentDirectory' will be used. -- +-- If the given 'Pattern' starts with a path separator, it is not relative to +-- the given directory and the @dir@ parameter is completely ignored! +-- -- Note that in some cases results outside the given directory may be returned: -- for instance the @.*@ pattern matches the @..@ directory. -- @@ -84,8 +90,8 @@ c <- getRecursiveContents dir' return ([], DL.toList c) -globDirWith opts pats dir = do - results <- mapM (\p -> globDir' opts (separate p) dir) pats +globDirWith opts pats@(_:_) dir = do + results <- mapM (\p -> globDir'0 opts p dir) pats let (matches, others) = unzip results allMatches = DL.toList . DL.concat $ matches @@ -100,11 +106,27 @@ globDir1 :: Pattern -> FilePath -> IO [FilePath] globDir1 p = fmap (head . fst) . globDir [p] +-- |A convenience wrapper on top of 'globDir1', for when you want to work in +-- the current directory or have a 'Pattern' referring to an absolute path. +glob :: Pattern -> IO [FilePath] +glob = flip globDir1 "" + +globDir'0 :: MatchOptions -> Pattern -> FilePath + -> IO (DList FilePath, DList FilePath) +globDir'0 opts pat dir = do + (dir',pat') <- + if maybe False (==PathSeparator) . listToMaybe . unPattern $ pat + then do + curDir <- getCurrentDirectory + return (takeDrive curDir, liftP (dropWhile (==PathSeparator)) pat) + else fmap (flip (,) pat) $ + if null dir then getCurrentDirectory else return dir + globDir' opts (separate pat') dir' + globDir' :: MatchOptions -> [TypedPattern] -> FilePath -> IO (DList FilePath, DList FilePath) globDir' opts pats@(_:_) dir = do - dir' <- if null dir then getCurrentDirectory else return dir - entries <- getDirectoryContents dir' `catch` const (return []) + entries <- getDirectoryContents dir `catch` const (return []) results <- forM entries $ \e -> matchTypedAndGo opts pats e (dir e)