ui for selecting a repository group

This commit is contained in:
Joey Hess 2012-10-10 16:23:41 -04:00
parent 39be7eea40
commit 4e2e08b45a
4 changed files with 28 additions and 17 deletions

View file

@ -68,9 +68,7 @@ makeGroupMap byuuid = GroupMap byuuid bygroup
explode (u, s) = map (\g -> (g, S.singleton u)) (S.toList s)
{- If a repository is in exactly one standard group, returns it. -}
getStandardGroup :: UUID -> GroupMap -> Maybe StandardGroup
getStandardGroup u m = maybe Nothing go $ u `M.lookup` groupsByUUID m
where
go s = case catMaybes $ map toStandardGroup $ S.toList s of
[g] -> Just g
_ -> Nothing
getStandardGroup :: S.Set Group -> Maybe StandardGroup
getStandardGroup s = case catMaybes $ map toStandardGroup $ S.toList s of
[g] -> Just g
_ -> Nothing

View file

@ -89,9 +89,8 @@ makeMatcher groupmap u s
{- Standard matchers are pre-defined for some groups. If none is defined,
- or a repository is in multiple groups with standard matchers, match all. -}
standardMatcher :: GroupMap -> UUID -> Utility.Matcher.Matcher MatchFiles
standardMatcher m u = maybe matchAll use (getStandardGroup u m)
where
use = makeMatcher m u . preferredContent
standardMatcher m u = maybe matchAll (makeMatcher m u . preferredContent) $
getStandardGroup =<< u `M.lookup` groupsByUUID m
matchAll :: Utility.Matcher.Matcher MatchFiles
matchAll = Utility.Matcher.generate []