diff --git a/Annex/View.hs b/Annex/View.hs index 28628cb05d..c572c6de4e 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -90,12 +90,37 @@ data ViewChange = Unchanged | Narrowing | Widening {- Updates a view, adding new fields to filter on (Narrowing), - or allowing new values in an existing field (Widening). -} refineView :: View -> [(MetaField, ViewFilter)] -> (View, ViewChange) -refineView = go Unchanged +refineView origview = checksize . calc Unchanged origview where - go c v [] = (v, c) - go c v ((f, vf):rest) = - let (v', c') = refineView' v f vf - in go (max c c') v' rest + calc c v [] = (v, c) + calc c v ((f, vf):rest) = + let (v', c') = refine v f vf + in calc (max c c') v' rest + + refine view field vf + | field `elem` map viewField (viewComponents view) = + let (components', viewchanges) = runWriter $ + mapM (\c -> updateViewComponent c field vf) (viewComponents view) + viewchange = if field `elem` map viewField (viewComponents origview) + then maximum viewchanges + else Narrowing + in (view { viewComponents = components' }, viewchange) + | otherwise = + let component = mkViewComponent field vf + view' = view { viewComponents = component : viewComponents view } + in (view', Narrowing) + + checksize r@(v, _) + | viewTooLarge v = error $ "View is too large (" ++ show (visibleViewSize v) ++ " levels of subdirectories)" + | otherwise = r + +updateViewComponent :: ViewComponent -> MetaField -> ViewFilter -> Writer [ViewChange] ViewComponent +updateViewComponent c field vf + | viewField c == field = do + let (newvf, viewchange) = combineViewFilter (viewFilter c) vf + tell [viewchange] + return $ mkViewComponent field newvf + | otherwise = return c {- Adds an additional filter to a view. This can only result in narrowing - the view. Multivalued filters are added in non-visible form. -} @@ -106,27 +131,6 @@ filterView v vs = v { viewComponents = viewComponents f' ++ viewComponents v} f' = f { viewComponents = map toinvisible (viewComponents f) } toinvisible c = c { viewVisible = False } -refineView' :: View -> MetaField -> ViewFilter -> (View, ViewChange) -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 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 - updatefield :: ViewComponent -> Writer [ViewChange] ViewComponent - updatefield v - | viewField v == field = do - let (newvf, viewchange) = combineViewFilter (viewFilter v) vf - tell [viewchange] - return $ v { viewFilter = newvf } - | otherwise = return v - {- Combine old and new ViewFilters, yielding a result that matches - either old+new, or only new. - diff --git a/Command/VCycle.hs b/Command/VCycle.hs index b41e099a48..f7da47fa27 100644 --- a/Command/VCycle.hs +++ b/Command/VCycle.hs @@ -36,6 +36,6 @@ start = go =<< currentView else next $ next $ checkoutViewBranch v' narrowView vcycle rest (c:cs) - | multiValue (viewFilter c) = rest ++ cs ++ [c] + | viewVisible c = rest ++ cs ++ [c] | otherwise = vcycle (c:rest) cs vcycle rest c = rest ++ c diff --git a/Types/View.hs b/Types/View.hs index fd73d92e48..43afdb8c85 100644 --- a/Types/View.hs +++ b/Types/View.hs @@ -50,6 +50,9 @@ instance Arbitrary ViewFilter where , return (ExcludeValues s) ) +mkViewComponent :: MetaField -> ViewFilter -> ViewComponent +mkViewComponent f vf = ViewComponent f vf (multiValue vf) + {- Can a ViewFilter match multiple different MetaValues? -} multiValue :: ViewFilter -> Bool multiValue (FilterValues s) = S.size s > 1 diff --git a/debian/changelog b/debian/changelog index 2082e6ace6..6124ba1350 100644 --- a/debian/changelog +++ b/debian/changelog @@ -14,6 +14,7 @@ git-annex (5.20140228) UNRELEASED; urgency=medium 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. + * vadd: Allow listing multiple desired values for a field. -- Joey Hess Fri, 28 Feb 2014 14:52:15 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 3ce4f025e2..59abfd37a3 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -759,7 +759,7 @@ subdirectories). Filters the current view to only the files that have the specified field values and tags. -* `vadd [field=glob ...]` +* `vadd [field=glob ...] [field=value ...]` Changes the current view, adding an additional level of directories to categorize the files.