added preferred-content log, and allow editing it with vicfg

This includes a full parser for the boolean expressions in the log,
that compiles them into Matchers. Those matchers are not used yet.

A complication is that matching against an expression should never
crash git-annex with an error. Instead, vicfg checks that the expressions
parse. If a bad expression (or an expression understood by some future
git-annex version) gets into the log, it'll be ignored.

Most of the code in Limit couldn't fail anyway, but I did have to make
limitCopies check its parameter first, and return an error if it's bad,
rather than erroring at runtime.

1 files changed, 31 insertions, 9 deletions

diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs
index d44967b28..31b8f6f01 100644
--- a/Command/Vicfg.hs
+++ b/Command/Vicfg.hs
@@ -20,6 +20,7 @@ import Types.TrustLevel
 import Types.Group
 import Logs.Trust
 import Logs.Group
+import Logs.PreferredContent
 import Remote
 
 def :: [Command]
@@ -55,6 +56,7 @@ vicfg curcfg f = do
 data Cfg = Cfg
 	{ cfgTrustMap :: TrustMap
 	, cfgGroupMap :: M.Map UUID (S.Set Group)
+	, cfgPreferredContentMap :: M.Map UUID String
 	, cfgDescriptions :: M.Map UUID String
 	}
 
@@ -62,26 +64,29 @@ getCfg :: Annex Cfg
 getCfg = Cfg
 	<$> trustMapRaw -- without local trust overrides
 	<*> (groupsByUUID <$> groupMap)
+	<*> preferredContentMapRaw
 	<*> uuidDescriptions
 
-emptyCfg :: Cfg
-emptyCfg = Cfg M.empty M.empty M.empty
-
 setCfg :: Cfg -> Cfg -> Annex ()
 setCfg curcfg newcfg = do
-	let (trustchanges, groupchanges) = diffCfg curcfg newcfg
-	mapM_ (\(u,t) -> trustSet u t) $ M.toList trustchanges
-	mapM_ (\(u, gs) -> groupChange u $ const gs) $ M.toList groupchanges
+	let (trustchanges, groupchanges, preferredcontentchanges) = diffCfg curcfg newcfg
+	mapM_ (uncurry trustSet) $ M.toList trustchanges
+	mapM_ (uncurry groupSet) $ M.toList groupchanges
+	mapM_ (uncurry preferredContentSet) $ M.toList preferredcontentchanges
 
-diffCfg :: Cfg -> Cfg -> (TrustMap, M.Map UUID (S.Set Group))
-diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap)
+diffCfg :: Cfg -> Cfg -> (TrustMap, M.Map UUID (S.Set Group), M.Map UUID String)
+diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredContentMap)
 	where
 		diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x)
 			(f newcfg) (f curcfg)
 
 genCfg :: Cfg -> String
 genCfg cfg = unlines $ concat
-	[intro, trustintro, trust, defaulttrust, groupsintro, groups, defaultgroups]
+	[ intro
+	, trustintro, trust, defaulttrust
+	, groupsintro, groups, defaultgroups
+	, preferredcontentintro, preferredcontent, defaultpreferredcontent
+	]
 	where
 		intro =
 			[ com "git-annex configuration"
@@ -91,6 +96,7 @@ genCfg cfg = unlines $ concat
 			, com "Lines in this file have the format:"
 			, com "  setting repo = value"
 			]
+
 		trustintro =
 			[ ""
 			, com "Repository trust configuration"
@@ -100,6 +106,7 @@ genCfg cfg = unlines $ concat
 			]
 		trust = map (\(t, u) -> line "trust" u $ showTrustLevel t) $
 			sort $ map swap $ M.toList $ cfgTrustMap cfg
+
 		defaulttrust = map (\u -> pcom $ line "trust" u $ showTrustLevel SemiTrusted) $
 			missing cfgTrustMap
 		groupsintro = 
@@ -112,6 +119,15 @@ genCfg cfg = unlines $ concat
 		defaultgroups = map (\u -> pcom $ line "group" u "") $
 			missing cfgGroupMap
 
+		preferredcontentintro = 
+			[ ""
+			, com "Repository preferred contents"
+			]
+		preferredcontent = sort $ map (\(s, u) -> line "preferred-content" u s) $
+			map swap $ M.toList $ cfgPreferredContentMap cfg
+		defaultpreferredcontent = map (\u -> pcom $ line "preferred-content" u "") $
+			missing cfgPreferredContentMap
+
 		line setting u value = unwords
 			[ setting
 			, showu u
@@ -160,6 +176,12 @@ parseCfg curcfg = go [] curcfg . lines
 			| setting == "group" =
 				let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)
 				in Right $ cfg { cfgGroupMap = m }
+			| setting == "preferred-content" = 
+				case checkPreferredContentExpression value of
+					Just e -> Left e
+					Nothing ->
+						let m = M.insert u value (cfgPreferredContentMap cfg)
+						in Right $ cfg { cfgPreferredContentMap = m }
 			| otherwise = badval "setting" setting
 
 		name2uuid = M.fromList $ map swap $