[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 15:09:23 UTC 2010
The following commit has been merged in the master branch:
commit 8f0cb48158d2503fcb8b193b91a44234095ecb81
Author: John Goerzen <jgoerzen at complete.org>
Date: Sat Apr 8 02:32:07 2006 +0100
New modules: MissingH.Path.Glob and MissingH.Path.WildMatch
diff --git a/MissingH.cabal b/MissingH.cabal
index 81460c0..31249ac 100644
--- a/MissingH.cabal
+++ b/MissingH.cabal
@@ -21,7 +21,7 @@ Exposed-Modules: MissingH.Str, MissingH.IO, MissingH.IO.Binary, MissingH.List,
MissingH.Str.CSV,
MissingH.Cmd,
MissingH.FiniteMap, MissingH.Map, MissingH.Path, MissingH.Path.NameManip,
- MissingH.Path.FilePath,
+ MissingH.Path.FilePath, MissingH.Path.WildMatch, MissingH.Path.Glob,
MissingH.Time, MissingH.Time.ParseDate,
MissingH.Network,
MissingH.Network.FTP.Client,
diff --git a/MissingH/Path/Glob.hs b/MissingH/Path/Glob.hs
new file mode 100644
index 0000000..320dac9
--- /dev/null
+++ b/MissingH/Path/Glob.hs
@@ -0,0 +1,101 @@
+{- Copyright (C) 2006 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program 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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : MissingH.Path.Glob
+ Copyright : Copyright (C) 2006 John Goerzen
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John Goerzen <jgoerzen at complete.org>
+ Stability : provisional
+ Portability: portable
+
+Functions for expanding wildcards, filenames, and pathnames.
+
+For information on the metacharacters recognized, please see the notes
+in "MissingH.Path.WildMatch".
+
+-}
+
+module MissingH.Path.Glob(glob, vGlob) where
+import MissingH.List
+import System.IO
+import MissingH.IO.HVFS
+
+hasWild = hasAny "*?["
+
+{- | Takes a pattern. Returns a list of names that match that pattern.
+The pattern is evaluated by "MissingH.Path.WildMatch". This function
+does not perform tilde or environment variable expansion.
+
+Filenames that begin with a dot are not included in the result set unless
+that component of the pattern also begins with a dot.
+
+In MissingH, this function is defined as:
+>glob = vGlob SystemFS -}
+glob :: FilePath -> IO ()
+glob = vGlob SystemFS
+
+{- | Like 'glob', but works on both the system ("real") and HVFS virtual
+filesystems. -}
+vGlob :: HVFS a => a -> FilePath -> IO ()
+vGlob fs fn =
+ if not hasWild fn -- Don't try globbing if there are no wilds
+ then do de <- vDoesExist fs fn
+ if de
+ then return [fn]
+ else return []
+ else expandGlob fs fn -- It's there
+
+expandGlob :: HVFS a => a -> FilePath -> IO ()
+exnapdGlob fs fn =
+ case dirname of
+ "." -> runGlob "." basename
+ _ -> do dirlist <- if hasWild dirname
+ then expandGlob fs dirname
+ else return [dirname]
+ if hasWild basename
+ then do r <- mapM expandWildBase dirlist
+ return $ concat r
+ else do r <- mapM expandNormalBase dirlist
+ return $ concat r
+
+ where (dirname, basename) = splitFileName fn
+ expandWildBase :: FilePath -> IO [FilePath]
+ expandWildBase dname =
+ do dirglobs <- runGlob dname basename
+ return (map \globfn -> dname ++ "/" ++ globfn) dirglobs
+ expandNormalBase :: FilePath -> IO [FilePath]
+ expandNormalBase dname =
+ do isdir <- vDoesDirectoryExist dname
+ if (basename /= "." && basename /= "") || isdir
+ then return [dname ++ "/" ++ basename]
+ else return []
+
+runGlob :: HVFS a => a -> FilePath -> IO ()
+runGlob fs "" patt = runGlob fs "." patt
+runGlob fs dirname patt =
+ case tryJust ioErrors (vGetDirectoryContents fs dirname) of
+ Left _ -> []
+ Right names -> let matches = return . filter . wildCheckCase $ names
+ in if head patt == '.'
+ then matches
+ else filter (\x -> head x /= '.') matches
+
+
+
+
\ No newline at end of file
diff --git a/MissingH/Path/WildMatch.hs b/MissingH/Path/WildMatch.hs
new file mode 100644
index 0000000..0d72237
--- /dev/null
+++ b/MissingH/Path/WildMatch.hs
@@ -0,0 +1,104 @@
+{- Copyright (C) 2006 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program 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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : MissingH.Path.WildMatch
+ Copyright : Copyright (C) 2006 John Goerzen
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John Goerzen <jgoerzen at complete.org>
+ Stability : provisional
+ Portability: portable
+
+Matching filenames with wildcards. See also "MissingH.Path.Glob" for
+support for generating lists of files based on wildcards.
+
+Inspired by fnmatch.py, part of the Python standard library.
+
+Written by John Goerzen, jgoerzen\@complete.org
+
+The input wildcard for functions in this module is expected to be in
+the standard style of Posix shells.
+
+That is:
+
+>? matches exactly one character
+>\* matches zero or more characters
+>[list] matches any character in list
+>[!list] matches any character not in the list
+
+The returned regular expression will always end in \$ but never begins
+with ^, making it suitable for appending to the end of paths. If you want to
+match a given filename directly, you should prepend the ^ character to the
+returned value from this function.
+
+Please note:
+
+* Neither the path separator (the slash or backslash) nor the period carry
+any special meaning for the functions in this module. That is, @*@ will
+match @/@ in a filename. If this is not the behavior you want, you probably
+want "MissingH.Path.Glob" instead of this module.
+
+* Unlike the Unix shell, filenames that begin with a period are not ignored
+by this module. That is, @*.txt@ will match @.test.txt at .
+
+* This module does not current permit escaping of special characters.
+-}
+
+module MissingH.Path.WildMatch (-- * Wildcard matching
+ wildCheckCase,
+ wildToRegex
+ )
+
+where
+
+import Text.Regex
+import MissingH.Str
+
+{- | Convert a wildcard to an (uncompiled) regular expression.
+
+-}
+wildToRegex :: String -> String
+wildToRegex i = convwild i ++ "$"
+
+{- | Check the given name against the given pattern, being case-sensitive.
+
+The given pattern is forced to match the given name starting at the beginning.
+ -}
+wildCheckCase :: String -- ^ The wildcard pattern to use as the base
+ -> String -- ^ The filename to check against it
+ -> Bool -- ^ Result
+wildCheckCase patt name =
+ case matchRegex (mkRegex $ "^" ++ wildToRegex patt) name of
+ Nothing -> False
+ Just _ -> True
+
+-- This is SO MUCH CLEANER than the python implementation!
+
+convwild :: String -> String
+convwild [] = []
+convwild ('*':xs) = ".*" ++ convwild xs
+convwild ('?':xs) = "." ++ convwild xs
+convwild ('[':'!':xs) = "[^" ++ convpat xs
+convwild ('[':xs) = '[' : convpat xs
+convwild (x:xs) = escapeRe [x] ++ convwild xs
+
+convpat :: String -> String
+convpat ('\\':xs) = "\\\\" ++ convpat xs
+convpat (']':xs) = ']' ++ convwild xs
+convpat (x:xs) = x : convpat xs
+
\ No newline at end of file
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list