view, vfilter: Add support for filtering tags and values out of a view, using !tag and field!=value.

Note that negated globs are not supported. Would have complicated the code
to add them, without changing the data type serialization in a
non-backwards-compatable way.

This commit was sponsored by Denver Gingerich.

Annex/View.hs

@@ -11,6 +11,7 @@ import Common.Annex
 import Annex.View.ViewedFile
 import Types.View
 import Types.MetaData
+import Annex.MetaData
 import qualified Git
 import qualified Git.DiffTree as DiffTree
 import qualified Git.Branch
@@ -51,48 +52,77 @@ viewTooLarge view = visibleViewSize view > 5
 visibleViewSize :: View -> Int
 visibleViewSize = length . filter viewVisible . viewComponents
 
+{- Parses field=value, field!=value, tag, and !tag
+ -
+ - Note that the field may not be a legal metadata field name,
+ - but it's let through anyway.
+ - This is useful when matching on directory names with spaces,
+ - which are not legal MetaFields.
+ -}
+parseViewParam :: String -> (MetaField, ViewFilter)
+parseViewParam s = case separate (== '=') s of
+	('!':tag, []) | not (null tag) ->
+		( tagMetaField
+		, mkExcludeValues tag
+		)
+	(tag, []) ->
+		( tagMetaField
+		, mkFilterValues tag
+		)
+	(field, wanted)
+		| end field == "!" ->
+			( mkMetaFieldUnchecked (beginning field)
+			, mkExcludeValues wanted
+			)
+		| otherwise ->
+			( mkMetaFieldUnchecked field
+			, mkFilterValues wanted
+			)
+  where
+	mkFilterValues v
+		| any (`elem` v) "*?" = FilterGlob v
+		| otherwise = FilterValues $ S.singleton $ toMetaValue v
+	mkExcludeValues = ExcludeValues . S.singleton . toMetaValue
+
 data ViewChange = Unchanged | Narrowing | Widening
 	deriving (Ord, Eq, Show)
 
 {- Updates a view, adding new fields to filter on (Narrowing), 
  - or allowing new values in an existing field (Widening). -}
-refineView :: View -> [(MetaField, String)] -> (View, ViewChange)
+refineView :: View -> [(MetaField, ViewFilter)] -> (View, ViewChange)
 refineView = go Unchanged
   where
   	go c v [] = (v, c)
-	go c v ((f, s):rest) =
+	go c v ((f, vf):rest) =
-		let (v', c') = refineView' v f s
+		let (v', c') = refineView' v f vf
 		in go (max c c') v' rest
 
 {- Adds an additional filter to a view. This can only result in narrowing
  - the view. Multivalued filters are added in non-visible form. -}
-filterView :: View -> [(MetaField, String)] -> View
+filterView :: View -> [(MetaField, ViewFilter)] -> View
 filterView v vs = v { viewComponents = viewComponents f' ++ viewComponents v}
   where
 	f = fst $ refineView (v {viewComponents = []}) vs
 	f' = f { viewComponents = map toinvisible (viewComponents f) }
 	toinvisible c = c { viewVisible = False }
 
-refineView' :: View -> MetaField -> String -> (View, ViewChange)
+refineView' :: View -> MetaField -> ViewFilter -> (View, ViewChange)
-refineView' view field wanted
+refineView' view field vf
 	| field `elem` (map viewField components) = 
 		let (components', viewchanges) = runWriter $ mapM updatefield components
 		in (view { viewComponents = components' }, maximum viewchanges)
 	| otherwise = 
-		let component = ViewComponent field viewfilter (multiValue viewfilter)
+		let component = ViewComponent field vf (multiValue vf)
 		    view' = view { viewComponents = component : components }
 		in if viewTooLarge view'
 			then error $ "View is too large (" ++ show (visibleViewSize view') ++ " levels of subdirectories)"
 			else (view', Narrowing)
   where
   	components = viewComponents view
-	viewfilter
-		| any (`elem` wanted) "*?" = FilterGlob wanted
-		| otherwise = FilterValues $ S.singleton $ toMetaValue wanted
 	updatefield :: ViewComponent -> Writer [ViewChange] ViewComponent
 	updatefield v
 		| viewField v == field = do
-			let (newvf, viewchange) = combineViewFilter (viewFilter v) viewfilter
+			let (newvf, viewchange) = combineViewFilter (viewFilter v) vf
 			tell [viewchange]
 			return $ v { viewFilter = newvf }
 		| otherwise = return v
@@ -117,6 +147,11 @@ combineViewFilter old@(FilterValues olds) (FilterValues news)
 	| otherwise = (combined, Widening)
   where
 	combined = FilterValues (S.union olds news)
+combineViewFilter old@(ExcludeValues olds) (ExcludeValues news)
+	| combined == old = (combined, Unchanged)
+	| otherwise = (combined, Narrowing)
+  where
+	combined = FilterValues (S.union olds news)
 combineViewFilter (FilterValues _) newglob@(FilterGlob _) =
 	(newglob, Widening)
 combineViewFilter (FilterGlob oldglob) new@(FilterValues s)
@@ -126,6 +161,10 @@ combineViewFilter (FilterGlob old) newglob@(FilterGlob new)
 	| old == new = (newglob, Unchanged)
 	| matchGlob (compileGlob old CaseInsensative) new = (newglob, Narrowing)
 	| otherwise = (newglob, Widening)
+combineViewFilter (FilterGlob _) new@(ExcludeValues _) = (new, Narrowing)
+combineViewFilter (ExcludeValues _) new@(FilterGlob _) = (new, Widening)
+combineViewFilter (FilterValues _) new@(ExcludeValues _) = (new, Narrowing)
+combineViewFilter (ExcludeValues _) new@(FilterValues _) = (new, Widening)
 
 {- Generates views for a file from a branch, based on its metadata
  - and the filename used in the branch.
@@ -162,16 +201,23 @@ viewedFiles view =
  - returns the value, or values that match. Self-memoizing on ViewComponent. -}
 viewComponentMatcher :: ViewComponent -> (MetaData -> Maybe [MetaValue])
 viewComponentMatcher viewcomponent = \metadata -> 
-	let s = matcher (currentMetaDataValues metafield metadata)
+	matcher (currentMetaDataValues metafield metadata)
-	in if S.null s then Nothing else Just (S.toList s)
   where
   	metafield = viewField viewcomponent
 	matcher = case viewFilter viewcomponent of
-		FilterValues s -> \values -> S.intersection s values
+		FilterValues s -> \values -> setmatches $
+			S.intersection s values
 		FilterGlob glob ->
 			let cglob = compileGlob glob CaseInsensative
-			in \values -> 
+			in \values -> setmatches $
 				S.filter (matchGlob cglob . fromMetaValue) values
+		ExcludeValues excludes -> \values -> 
+			if S.null (S.intersection values excludes)
+				then Just []
+				else Nothing
+	setmatches s
+		| S.null s = Nothing
+		| otherwise = Just (S.toList s)
 
 toViewPath :: MetaValue -> FilePath
 toViewPath = concatMap escapeslash . fromMetaValue

Command/VAdd.hs

@@ -10,7 +10,7 @@ module Command.VAdd where
 import Common.Annex
 import Command
 import Annex.View
-import Command.View (parseViewParam, checkoutViewBranch)
+import Command.View (checkoutViewBranch)
 
 def :: [Command]
 def = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB")

Command/VFilter.hs

@@ -10,7 +10,7 @@ module Command.VFilter where
 import Common.Annex
 import Command
 import Annex.View
-import Command.View (paramView, parseViewParam, checkoutViewBranch)
+import Command.View (paramView, checkoutViewBranch)
 
 def :: [Command]
 def = [notBareRepo $ notDirect $

Command/View.hs

@@ -13,8 +13,6 @@ import qualified Git
 import qualified Git.Command
 import qualified Git.Ref
 import qualified Git.Branch
-import Types.MetaData
-import Annex.MetaData
 import Types.View
 import Annex.View
 import Logs.View
@@ -46,18 +44,6 @@ perform view = do
 paramView :: String
 paramView = paramPair (paramRepeating "TAG") (paramRepeating "FIELD=VALUE")
 
-{- Parse field=value
- -
- - Note that the field may not be a legal metadata field name,
- - but it's let through anyway.
- - This is useful when matching on directory names with spaces,
- - which are not legal MetaFields.
- -}
-parseViewParam :: String -> (MetaField, String)
-parseViewParam s = case separate (== '=') s of
-	(tag, []) -> (tagMetaField, tag)
-	(field, wanted) -> (mkMetaFieldUnchecked field, wanted)
-
 mkView :: [String] -> Annex View
 mkView params = do
 	v <- View <$> viewbranch <*> pure []

Logs/View.hs

@@ -75,12 +75,14 @@ branchView view
 		| otherwise = "(" ++ branchcomp' c ++ ")"
 	branchcomp' (ViewComponent metafield viewfilter _) =concat
 		[ forcelegal (fromMetaField metafield)
-		, "="
 		, branchvals viewfilter
 		]
-	branchvals (FilterValues set) = intercalate "," $
+	branchvals (FilterValues set) = '=' : branchset set
-		map (forcelegal . fromMetaValue) $ S.toList set
+	branchvals (FilterGlob glob) = '=' : forcelegal glob
-	branchvals (FilterGlob glob) = forcelegal glob
+	branchvals (ExcludeValues set) = "!=" ++ branchset set
+	branchset = intercalate ","
+		. map (forcelegal . fromMetaValue)
+		. S.toList
 	forcelegal s
 		| Git.Ref.legal True s = s
 		| otherwise = map (\c -> if isAlphaNum c then c else '_') s

Types/View.hs

@@ -38,14 +38,20 @@ instance Arbitrary ViewComponent where
 data ViewFilter
 	= FilterValues (S.Set MetaValue)
 	| FilterGlob String
+	| ExcludeValues (S.Set MetaValue)
 	deriving (Eq, Read, Show)
 
 instance Arbitrary ViewFilter where
 	arbitrary = do
 		size <- arbitrarySizedBoundedIntegral `suchThat` (< 100)
-		FilterValues . S.fromList <$> vector size
+		s <- S.fromList <$> vector size
+		ifM arbitrary
+			( return (FilterValues s)
+			, return (ExcludeValues s)
+			)
 
 {- Can a ViewFilter match multiple different MetaValues? -}
 multiValue :: ViewFilter -> Bool
 multiValue (FilterValues s) = S.size s > 1
 multiValue (FilterGlob _) = True
+multiValue (ExcludeValues _) = False

debian/changelog

@@ -12,6 +12,8 @@ git-annex (5.20140228) UNRELEASED; urgency=medium
   * assistant --autostart: Refuse to start in a bare git repository.
   * webapp: Don't list the public repository group when editing a
     git repository; it only makes sense for special remotes.
+  * view, vfilter: Add support for filtering tags and values out of a view,
+    using !tag and field!=value.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 28 Feb 2014 14:52:15 -0400
 

doc/git-annex.mdwn

@@ -723,7 +723,7 @@ subdirectories).
 
         	git annex metadata annexscreencast.ogv -t video -t screencast -s author+=Alice
 
-* `view [tag ...] [field=value ...] [location/=value]`
+* `view [tag ...] [field=value ...] [field=glob ...] [!tag ...] [field!=value ...]`
 
   Uses metadata to build a view branch of the files in the current branch,
   and checks out the view branch. Only files in the current branch whose
@@ -754,12 +754,12 @@ subdirectories).
 
   The optional number tells how many views to pop.
 
-* `vfilter [tag ...] [field=value ...] [location/=value]`
+* `vfilter [tag ...] [field=value ...] [!tag ...] [field!=value ...]`
 
   Filters the current view to only the files that have the
-  specified field values, tags, and locations.
+  specified field values and tags.
 
-* `vadd [field=glob ...] [location/=glob]`
+* `vadd [field=glob ...]`
 
   Changes the current view, adding an additional level of directories
   to categorize the files.