--metadata field=value can now use globs to match, and matches case insensatively, the same as git annex view field=value does.

Also refactored glob code into its own module.

5 files changed, 83 insertions, 70 deletions

diff --git a/Annex/View.hs b/Annex/View.hs
index 78b4da589..fe32fdaa3 100644
--- a/Annex/View.hs
+++ b/Annex/View.hs
@@ -5,8 +5,6 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Annex.View where
 
 import Common.Annex
@@ -28,22 +26,15 @@ import Annex.Link
 import Annex.CatFile
 import Logs.MetaData
 import Logs.View
+import Utility.Glob
 import Utility.FileMode
 import Types.Command
 import Config
 import CmdLine.Action
 
 import qualified Data.Set as S
-import System.Path.WildMatch
 import "mtl" Control.Monad.Writer
 
-#ifdef WITH_TDFA
-import Text.Regex.TDFA
-import Text.Regex.TDFA.String
-#else
-import Text.Regex
-#endif
-
 {- Each visible ViewFilter in a view results in another level of
  - subdirectory nesting. When a file matches multiple ways, it will appear
  - in multiple subdirectories. This means there is a bit of an exponential
@@ -127,11 +118,11 @@ combineViewFilter old@(FilterValues olds) (FilterValues news)
 combineViewFilter (FilterValues _) newglob@(FilterGlob _) =
 	(newglob, Widening)
 combineViewFilter (FilterGlob oldglob) new@(FilterValues s)
-	| all (matchGlob (compileGlob oldglob) . fromMetaValue) (S.toList s) = (new, Narrowing)
+	| all (matchGlob (compileGlob oldglob CaseInsensative) . fromMetaValue) (S.toList s) = (new, Narrowing)
 	| otherwise = (new, Widening)
 combineViewFilter (FilterGlob old) newglob@(FilterGlob new)
 	| old == new = (newglob, Unchanged)
-	| matchGlob (compileGlob old) new = (newglob, Narrowing)
+	| matchGlob (compileGlob old CaseInsensative) new = (newglob, Narrowing)
 	| otherwise = (newglob, Widening)
 
 {- Converts a filepath used in a reference branch to the
@@ -205,31 +196,9 @@ viewComponentMatcher viewcomponent = \metadata ->
 	matcher = case viewFilter viewcomponent of
 		FilterValues s -> \values -> S.intersection s values
 		FilterGlob glob ->
-			let regex = compileGlob glob
+			let cglob = compileGlob glob CaseInsensative
 			in \values -> 
-				S.filter (matchGlob regex . fromMetaValue) values
-
-compileGlob :: String -> Regex
-compileGlob glob = 
-#ifdef WITH_TDFA
-	case compile (defaultCompOpt {caseSensitive = False}) defaultExecOpt regex of
-		Right r -> r
-		Left _ -> error $ "failed to compile regex: " ++ regex
-#else
-	mkRegexWithOpts regex False True
-#endif
-  where
-	regex = '^':wildToRegex glob
-
-matchGlob :: Regex -> String -> Bool
-matchGlob regex val = 
-#ifdef WITH_TDFA
-	case execute regex val of
-		Right (Just _) -> True
-		_ -> False
-#else
-	isJust $ matchRegex regex val
-#endif
+				S.filter (matchGlob cglob . fromMetaValue) values
 
 toViewPath :: MetaValue -> FilePath
 toViewPath = concatMap escapeslash . fromMetaValue
diff --git a/Limit.hs b/Limit.hs
index bee92889d..62c5456fe 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -5,8 +5,6 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Limit where
 
 import Common.Annex
@@ -29,18 +27,13 @@ import Logs.Group
 import Logs.Unused
 import Logs.Location
 import Git.Types (RefDate(..))
+import Utility.Glob
 import Utility.HumanTime
 import Utility.DataUnits
 
 import Data.Time.Clock.POSIX
 import qualified Data.Set as S
 import qualified Data.Map as M
-import System.Path.WildMatch
-
-#ifdef WITH_TDFA
-import Text.Regex.TDFA
-import Text.Regex.TDFA.String
-#endif
 
 {- Checks if there are user-specified limits. -}
 limited :: Annex Bool
@@ -82,33 +75,21 @@ addInclude :: String -> Annex ()
 addInclude = addLimit . limitInclude
 
 limitInclude :: MkLimit
-limitInclude glob = Right $ const $ return . matchglob glob
+limitInclude glob = Right $ const $ return . matchGlobFile glob
 
 {- Add a limit to skip files that match the glob. -}
 addExclude :: String -> Annex ()
 addExclude = addLimit . limitExclude
 
 limitExclude :: MkLimit
-limitExclude glob = Right $ const $ return . not . matchglob glob
-
-{- Could just use wildCheckCase, but this way the regex is only compiled
- - once. Also, we use regex-TDFA when available, because it's less buggy
- - in its support of non-unicode characters. -}
-matchglob :: String -> MatchInfo -> Bool
-matchglob glob (MatchingFile fi) =
-#ifdef WITH_TDFA
-	case cregex of
-		Right r -> case execute r (matchFile fi) of
-			Right (Just _) -> True
-			_ -> False
-		Left _ -> error $ "failed to compile regex: " ++ regex
-  where
-	cregex = compile defaultCompOpt defaultExecOpt regex
-	regex = '^':wildToRegex glob
-#else
-	wildCheckCase glob (matchFile fi)
-#endif
-matchglob _ (MatchingKey _) = False
+limitExclude glob = Right $ const $ return . not . matchGlobFile glob
+
+matchGlobFile :: String -> (MatchInfo -> Bool)
+matchGlobFile glob = go
+	where
+		cglob = compileGlob glob CaseSensative -- memoized
+		go (MatchingKey _) = False
+		go (MatchingFile fi) = matchGlob cglob (matchFile fi)
 
 {- Adds a limit to skip files not believed to be present
  - in a specfied repository. Optionally on a prior date. -}
@@ -270,9 +251,13 @@ addMetaData = addLimit . limitMetaData
 limitMetaData :: MkLimit
 limitMetaData s = case parseMetaData s of
 	Left e -> Left e
-	Right (f, v) -> Right $ const $ checkKey (check f v)
+	Right (f, v) ->
+		let cglob = compileGlob (fromMetaValue v) CaseInsensative
+		in Right $ const $ checkKey (check f cglob)
   where
-  	check f v k = S.member v . metaDataValues f <$> getCurrentMetaData k
+  	check f cglob k = not . S.null 
+		. S.filter (matchGlob cglob . fromMetaValue) 
+		. metaDataValues f <$> getCurrentMetaData k
 
 addTimeLimit :: String -> Annex ()
 addTimeLimit s = do
diff --git a/Utility/Glob.hs b/Utility/Glob.hs
new file mode 100644
index 000000000..5291af452
--- /dev/null
+++ b/Utility/Glob.hs
@@ -0,0 +1,57 @@
+{- file globbing
+ -
+ - This uses TDFA when available, with a fallback to regex-compat.
+ - TDFA is less buggy in its support for non-unicode characters.
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.Glob (
+	Glob,
+	GlobCase(..),
+	compileGlob,
+	matchGlob
+) where
+
+import System.Path.WildMatch
+
+#ifdef WITH_TDFA
+import Text.Regex.TDFA
+import Text.Regex.TDFA.String
+#else
+import Text.Regex
+#endif
+
+newtype Glob = Glob Regex
+
+data GlobCase = CaseSensative | CaseInsensative
+
+{- Compiles a glob to a regex, that can be repeatedly used. -}
+compileGlob :: String -> GlobCase -> Glob
+compileGlob glob globcase = Glob $
+#ifdef WITH_TDFA
+	case compile (defaultCompOpt {caseSensitive = casesentitive}) defaultExecOpt regex of
+		Right r -> r
+		Left _ -> error $ "failed to compile regex: " ++ regex
+#else
+	mkRegexWithOpts regex casesentitive True
+#endif
+  where
+	regex = '^':wildToRegex glob
+	casesentitive = case globcase of
+		CaseSensative -> True
+		CaseInsensative -> False
+
+matchGlob :: Glob -> String -> Bool
+matchGlob (Glob regex) val = 
+#ifdef WITH_TDFA
+	case execute regex val of
+		Right (Just _) -> True
+		_ -> False
+#else
+	isJust $ matchRegex regex val
+#endif
diff --git a/debian/changelog b/debian/changelog
index d39e4fbd1..37193891a 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,8 @@ git-annex (5.20140222) UNRELEASED; urgency=medium
 
   * Fix handling of rsync remote urls containing a username,
     including rsync.net.
+  * --metadata field=value can now use globs to match, and matches
+    case insensatively, the same as git annex view field=value does.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 21 Feb 2014 13:03:04 -0400
 
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 0912e0b2a..97f2b2918 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -1133,10 +1133,10 @@ file contents are present at either of two repositories.
   The size can be specified with any commonly used units, for example,
   "0.5 gb" or "100 KiloBytes"
 
-* `--metadata field=value`
+* `--metadata field=glob`
 
-  Matches only files that have a metadata field attached with the specified
-  value.
+  Matches only files that have a metadata field attached with a value that
+  matches the glob.
 
 * `--want-get`