aboutsummaryrefslogtreecommitdiff
path: root/Annex/View.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-03-02 15:36:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-03-02 15:36:45 -0400
commit4391e9bde8803a014ef723339dde5fdb386f4ba1 (patch)
treef27e5dad87edd48c938a9b2bf7b1a74bfd05b2e0 /Annex/View.hs
parentd6744f85d3ad9b924eeee47148d34bec6992b5eb (diff)
vadd: Allow listing multiple desired values for a field.
Diffstat (limited to 'Annex/View.hs')
-rw-r--r--Annex/View.hs56
1 files changed, 30 insertions, 26 deletions
diff --git a/Annex/View.hs b/Annex/View.hs
index 28628cb05..c572c6de4 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.
-