vicfg: New file format, avoids ambiguity with repos that have the same description, or no description.

This is also nice in that uuids are all the same length, so the values
of each line, line up.

Also a great deal of boilerplate elimination.

1 files changed, 33 insertions, 46 deletions

diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs
index 31b8f6f01..178efec3a 100644
--- a/Command/Vicfg.hs
+++ b/Command/Vicfg.hs
@@ -35,7 +35,8 @@ start = do
 	f <- fromRepo gitAnnexTmpCfgFile
 	createAnnexDirectory $ parentDir f
 	cfg <- getCfg
-	liftIO $ writeFile f $ genCfg cfg
+	descs <- uuidDescriptions
+	liftIO $ writeFile f $ genCfg cfg descs
 	vicfg cfg f
 	stop
 
@@ -57,7 +58,6 @@ data Cfg = Cfg
 	{ cfgTrustMap :: TrustMap
 	, cfgGroupMap :: M.Map UUID (S.Set Group)
 	, cfgPreferredContentMap :: M.Map UUID String
-	, cfgDescriptions :: M.Map UUID String
 	}
 
 getCfg :: Annex Cfg
@@ -65,7 +65,6 @@ getCfg = Cfg
 	<$> trustMapRaw -- without local trust overrides
 	<*> (groupsByUUID <$> groupMap)
 	<*> preferredContentMapRaw
-	<*> uuidDescriptions
 
 setCfg :: Cfg -> Cfg -> Annex ()
 setCfg curcfg newcfg = do
@@ -80,13 +79,8 @@ diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredCo
 		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
-	, preferredcontentintro, preferredcontent, defaultpreferredcontent
-	]
+genCfg :: Cfg -> M.Map UUID String -> String
+genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent]
 	where
 		intro =
 			[ com "git-annex configuration"
@@ -94,50 +88,48 @@ genCfg cfg = 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 repo = value"
+			, com "  setting uuid = value"
 			]
 
-		trustintro =
+		trust = settings cfgTrustMap
 			[ ""
 			, com "Repository trust configuration"
 			, com "(Valid trust levels: " ++
 			  unwords (map showTrustLevel [Trusted .. DeadTrusted]) ++
 			  ")"
 			]
-		trust = map (\(t, u) -> line "trust" u $ showTrustLevel t) $
-			sort $ map swap $ M.toList $ cfgTrustMap cfg
+			(\(t, u) -> line "trust" u $ showTrustLevel t)
+			(\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted)
 
-		defaulttrust = map (\u -> pcom $ line "trust" u $ showTrustLevel SemiTrusted) $
-			missing cfgTrustMap
-		groupsintro = 
+		groups = settings cfgGroupMap
 			[ ""
 			, com "Repository groups"
 			, com "(Separate group names with spaces)"
 			]
-		groups = sort $ map (\(s, u) -> line "group" u $ unwords $ S.toList s) $
-			map swap $ M.toList $ cfgGroupMap cfg
-		defaultgroups = map (\u -> pcom $ line "group" u "") $
-			missing cfgGroupMap
+			(\(s, u) -> line "group" u $ unwords $ S.toList s)
+			(\u -> lcom $ line "group" u "")
 
-		preferredcontentintro = 
+		preferredcontent = settings cfgPreferredContentMap
 			[ ""
 			, 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
-			, "=" 
-			, value
+			(\(s, u) -> line "preferred-content" u s)
+			(\u -> line "preferred-content" u "")
+
+		settings field desc showvals showdefaults = concat
+			[ desc
+			, concatMap showvals $
+				sort $ map swap $ M.toList $ field cfg
+			, concatMap (\u -> lcom $ showdefaults u) $
+				missing field
 			]
-		pcom s = "#" ++ s
-		showu u = fromMaybe (fromUUID u) $
-			M.lookup u (cfgDescriptions cfg)
-		missing field = S.toList $ M.keysSet (cfgDescriptions cfg) `S.difference` M.keysSet (field cfg)
+
+		line setting u value =
+			[ com $ "(" ++ (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)
 
 {- If there's a parse error, returns a new version of the file,
  - with the problem lines noted. -}
@@ -155,16 +147,14 @@ parseCfg curcfg = go [] curcfg . lines
 		parse l cfg
 			| null l = Right cfg
 			| "#" `isPrefixOf` l = Right cfg
-			| null setting || null repo' = Left "missing repository name"
-			| otherwise = case M.lookup repo' name2uuid of
-				Nothing -> badval "repository" repo'
-				Just u -> handle cfg u setting value'
+			| null setting || null u = Left "missing repository uuid"
+			| otherwise = handle cfg (toUUID u) setting value'
 			where
 				(setting, rest) = separate isSpace l
-				(repo, value) = separate (== '=') rest
+				(r, value) = separate (== '=') rest
 				value' = trimspace value
-				repo' = reverse $ trimspace $
-					reverse $ trimspace repo
+				u = reverse $ trimspace $
+					reverse $ trimspace r
 				trimspace = dropWhile isSpace
 
 		handle cfg u setting value
@@ -184,9 +174,6 @@ parseCfg curcfg = go [] curcfg . lines
 						in Right $ cfg { cfgPreferredContentMap = m }
 			| otherwise = badval "setting" setting
 
-		name2uuid = M.fromList $ map swap $
-			M.toList $ cfgDescriptions curcfg
-
 		showerr (Just msg, l) = [parseerr ++ msg, l]
 		showerr (Nothing, l)
 			-- filter out the header and parse error lines