vicfg: Allows editing preferred content expressions for groups.

This is stored in the git-annex branch, but not yet actually hooked up and
used.

1 files changed, 95 insertions, 45 deletions

diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs
index 7608959c2..94fc36184 100644
--- a/Command/Vicfg.hs
+++ b/Command/Vicfg.hs
@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -60,7 +60,8 @@ vicfg curcfg f = do
 data Cfg = Cfg
 	{ cfgTrustMap :: TrustMap
 	, cfgGroupMap :: M.Map UUID (S.Set Group)
-	, cfgPreferredContentMap :: M.Map UUID String
+	, cfgPreferredContentMap :: M.Map UUID PreferredContentExpression
+	, cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression
 	, cfgScheduleMap :: M.Map UUID [ScheduledActivity]
 	}
 
@@ -69,25 +70,40 @@ getCfg = Cfg
 	<$> trustMapRaw -- without local trust overrides
 	<*> (groupsByUUID <$> groupMap)
 	<*> preferredContentMapRaw
+	<*> groupPreferredContentMapRaw
 	<*> scheduleMap
 
 setCfg :: Cfg -> Cfg -> Annex ()
 setCfg curcfg newcfg = do
-	let (trustchanges, groupchanges, preferredcontentchanges, schedulechanges) = diffCfg curcfg newcfg
-	mapM_ (uncurry trustSet) $ M.toList trustchanges
-	mapM_ (uncurry groupSet) $ M.toList groupchanges
-	mapM_ (uncurry preferredContentSet) $ M.toList preferredcontentchanges
-	mapM_ (uncurry scheduleSet) $ M.toList schedulechanges
-
-diffCfg :: Cfg -> Cfg -> (TrustMap, M.Map UUID (S.Set Group), M.Map UUID String, M.Map UUID [ScheduledActivity])
-diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredContentMap, diff cfgScheduleMap)
+	let diff = diffCfg curcfg newcfg
+	mapM_ (uncurry trustSet) $ M.toList $ cfgTrustMap diff
+	mapM_ (uncurry groupSet) $ M.toList $ cfgGroupMap diff
+	mapM_ (uncurry preferredContentSet) $ M.toList $ cfgPreferredContentMap diff
+	mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff
+	mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff
+
+diffCfg :: Cfg -> Cfg -> Cfg
+diffCfg curcfg newcfg = Cfg
+	{ cfgTrustMap = diff cfgTrustMap
+	, cfgGroupMap = diff cfgGroupMap
+	, cfgPreferredContentMap = diff cfgPreferredContentMap
+	, cfgGroupPreferredContentMap = diff cfgGroupPreferredContentMap
+	, cfgScheduleMap = diff cfgScheduleMap
+	}
   where
 	diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x)
 		(f newcfg) (f curcfg)
 
 genCfg :: Cfg -> M.Map UUID String -> String
-genCfg cfg descs = unlines $ concat
-	[intro, trust, groups, preferredcontent, schedule]
+genCfg cfg descs = unlines $ intercalate [""]
+	[ intro
+	, trust
+	, groups
+	, preferredcontent
+	, grouppreferredcontent
+	, standardgroups
+	, schedule
+	]
   where
 	intro =
 		[ com "git-annex configuration"
@@ -95,22 +111,20 @@ genCfg cfg descs = unlines $ concat
 		, com "Changes saved to this file will be recorded in the git-annex branch."
 		, com ""
 		, com "Lines in this file have the format:"
-		, com "  setting uuid = value"
+		, com "  setting field = value"
 		]
 
-	trust = settings cfgTrustMap
-		[ ""
-		, com "Repository trust configuration"
+	trust = settings cfg descs cfgTrustMap
+		[ com "Repository trust configuration"
 		, com "(Valid trust levels: " ++ trustlevels ++ ")"
 		]
 		(\(t, u) -> line "trust" u $ showTrustLevel t)
 		(\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted)
 	  where
-	  	trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted]
+		trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted]
 
-	groups = settings cfgGroupMap
-		[ ""
-		, com "Repository groups"
+	groups = settings cfg descs cfgGroupMap
+		[ com "Repository groups"
 		, com $ "(Standard groups: " ++ grouplist ++ ")"
 		, com "(Separate group names with spaces)"
 		]
@@ -119,33 +133,60 @@ genCfg cfg descs = unlines $ concat
 	  where
 	  	grouplist = unwords $ map fromStandardGroup [minBound..]
 
-	preferredcontent = settings cfgPreferredContentMap
-		[ ""
-		, com "Repository preferred contents"
+	preferredcontent = settings cfg descs cfgPreferredContentMap
+		[ com "Repository preferred contents" ]
+		(\(s, u) -> line "wanted" u s)
+		(\u -> line "wanted" u "standard")
+
+	grouppreferredcontent = settings' cfg allgroups cfgGroupPreferredContentMap
+		[ com "Group preferred contents"
+		, com "(Used by repositories with \"groupwanted\" in their preferred contents)"
 		]
-		(\(s, u) -> line "content" u s)
-		(\u -> line "content" u "")
+		(\(s, g) -> gline g s)
+		(\g -> gline g "standard")
+	  where
+	  	gline g value = [ unwords ["groupwanted", g, "=", value] ]
+		allgroups = S.unions $ stdgroups : M.elems (cfgGroupMap cfg)
+		stdgroups = S.fromList $ map fromStandardGroup [minBound..maxBound]
 
-	schedule = settings cfgScheduleMap
-		[ ""
-		, com "Scheduled activities"
+	standardgroups =
+		[ com "Standard preferred contents"
+		, com "(Used by wanted or groupwanted expressions containing \"standard\")"
+		, com "(For reference only; built-in and cannot be changed!)"
+		]
+		++ map gline [minBound..maxBound]
+	  where
+		gline g = com $ unwords
+			[ "standard"
+			, fromStandardGroup g, "=", preferredContent g
+			]
+	
+	schedule = settings cfg descs cfgScheduleMap
+		[ com "Scheduled activities"
 		, com "(Separate multiple activities with \"; \")"
 		]
 		(\(l, u) -> line "schedule" u $ fromScheduledActivities l)
 		(\u -> line "schedule" u "")
 
-	settings field desc showvals showdefaults = concat
-		[ desc
-		, concatMap showvals $ sort $ map swap $ M.toList $ field cfg
-		, concatMap (lcom . showdefaults) $ missing field
-		]
-
 	line setting u value =
 		[ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")"
 		, unwords [setting, fromUUID u, "=", value]
 		]
-	lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l)
-	missing field = S.toList $ M.keysSet descs `S.difference` M.keysSet (field cfg)
+	
+settings :: Ord v => Cfg -> M.Map UUID String -> (Cfg -> M.Map UUID v) -> [String] -> ((v, UUID) -> [String]) -> (UUID -> [String]) -> [String]
+settings cfg descs = settings' cfg (M.keysSet descs)
+
+settings' :: (Ord v, Ord f) => Cfg -> S.Set f -> (Cfg -> M.Map f v) -> [String] -> ((v, f) -> [String]) -> (f -> [String]) -> [String]
+settings' cfg s field desc showvals showdefaults = concat
+	[ desc
+	, concatMap showvals $ sort $ map swap $ M.toList $ field cfg
+	, concatMap (lcom . showdefaults) missing
+	]
+  where
+	missing = S.toList $ s `S.difference` M.keysSet (field cfg)
+
+lcom :: [String] -> [String]
+lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l)
 
 {- If there's a parse error, returns a new version of the file,
  - with the problem lines noted. -}
@@ -163,16 +204,16 @@ parseCfg curcfg = go [] curcfg . lines
 	parse l cfg
 		| null l = Right cfg
 		| "#" `isPrefixOf` l = Right cfg
-		| null setting || null u = Left "missing repository uuid"
-		| otherwise = handle cfg (toUUID u) setting value'
+		| null setting || null f = Left "missing field"
+		| otherwise = handle cfg f setting value'
 	  where
 		(setting, rest) = separate isSpace l
 		(r, value) = separate (== '=') rest
 		value' = trimspace value
-		u = reverse $ trimspace $ reverse $ trimspace r
+		f = reverse $ trimspace $ reverse $ trimspace r
 		trimspace = dropWhile isSpace
 
-	handle cfg u setting value
+	handle cfg f setting value
 		| setting == "trust" = case readTrustLevel value of
 			Nothing -> badval "trust value" value
 			Just t ->
@@ -181,18 +222,26 @@ parseCfg curcfg = go [] curcfg . lines
 		| setting == "group" =
 			let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)
 			in Right $ cfg { cfgGroupMap = m }
-		| setting == "content" = 
+		| setting == "wanted" = 
 			case checkPreferredContentExpression value of
 				Just e -> Left e
 				Nothing ->
 					let m = M.insert u value (cfgPreferredContentMap cfg)
 					in Right $ cfg { cfgPreferredContentMap = m }
+		| setting == "groupwanted" =
+			case checkPreferredContentExpression value of
+				Just e -> Left e
+				Nothing ->
+					let m = M.insert f value (cfgGroupPreferredContentMap cfg)
+					in Right $ cfg { cfgGroupPreferredContentMap = m }
 		| setting == "schedule" = case parseScheduledActivities value of
 			Left e -> Left e
 			Right l -> 
 				let m = M.insert u l (cfgScheduleMap cfg)
 				in Right $ cfg { cfgScheduleMap = m }
 		| otherwise = badval "setting" setting
+	  where
+		u = toUUID f
 
 	showerr (Just msg, l) = [parseerr ++ msg, l]
 	showerr (Nothing, l)
@@ -203,11 +252,12 @@ parseCfg curcfg = go [] curcfg . lines
 
 	badval desc val = Left $ "unknown " ++ desc ++ " \"" ++ val ++ "\""
 	badheader = 
-		[ com "There was a problem parsing your input."
-		, com "Search for \"Parse error\" to find the bad lines."
-		, com "Either fix the bad lines, or delete them (to discard your changes)."
+		[ com "** There was a problem parsing your input!"
+		, com "** Search for \"Parse error\" to find the bad lines."
+		, com "** Either fix the bad lines, or delete them (to discard your changes)."
+		, ""
 		]
-	parseerr = com "Parse error in next line: "
+	parseerr = com "** Parse error in next line: "
 
 com :: String -> String
 com s = "# " ++ s