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.
This commit is contained in:
parent
ab9c032deb
commit
e52fc5ba89
2 changed files with 39 additions and 45 deletions
|
@ -35,7 +35,8 @@ start = do
|
||||||
f <- fromRepo gitAnnexTmpCfgFile
|
f <- fromRepo gitAnnexTmpCfgFile
|
||||||
createAnnexDirectory $ parentDir f
|
createAnnexDirectory $ parentDir f
|
||||||
cfg <- getCfg
|
cfg <- getCfg
|
||||||
liftIO $ writeFile f $ genCfg cfg
|
descs <- uuidDescriptions
|
||||||
|
liftIO $ writeFile f $ genCfg cfg descs
|
||||||
vicfg cfg f
|
vicfg cfg f
|
||||||
stop
|
stop
|
||||||
|
|
||||||
|
@ -57,7 +58,6 @@ data Cfg = Cfg
|
||||||
{ cfgTrustMap :: TrustMap
|
{ cfgTrustMap :: TrustMap
|
||||||
, cfgGroupMap :: M.Map UUID (S.Set Group)
|
, cfgGroupMap :: M.Map UUID (S.Set Group)
|
||||||
, cfgPreferredContentMap :: M.Map UUID String
|
, cfgPreferredContentMap :: M.Map UUID String
|
||||||
, cfgDescriptions :: M.Map UUID String
|
|
||||||
}
|
}
|
||||||
|
|
||||||
getCfg :: Annex Cfg
|
getCfg :: Annex Cfg
|
||||||
|
@ -65,7 +65,6 @@ getCfg = Cfg
|
||||||
<$> trustMapRaw -- without local trust overrides
|
<$> trustMapRaw -- without local trust overrides
|
||||||
<*> (groupsByUUID <$> groupMap)
|
<*> (groupsByUUID <$> groupMap)
|
||||||
<*> preferredContentMapRaw
|
<*> preferredContentMapRaw
|
||||||
<*> uuidDescriptions
|
|
||||||
|
|
||||||
setCfg :: Cfg -> Cfg -> Annex ()
|
setCfg :: Cfg -> Cfg -> Annex ()
|
||||||
setCfg curcfg newcfg = do
|
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)
|
diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x)
|
||||||
(f newcfg) (f curcfg)
|
(f newcfg) (f curcfg)
|
||||||
|
|
||||||
genCfg :: Cfg -> String
|
genCfg :: Cfg -> M.Map UUID String -> String
|
||||||
genCfg cfg = unlines $ concat
|
genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent]
|
||||||
[ intro
|
|
||||||
, trustintro, trust, defaulttrust
|
|
||||||
, groupsintro, groups, defaultgroups
|
|
||||||
, preferredcontentintro, preferredcontent, defaultpreferredcontent
|
|
||||||
]
|
|
||||||
where
|
where
|
||||||
intro =
|
intro =
|
||||||
[ com "git-annex configuration"
|
[ 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 "Changes saved to this file will be recorded in the git-annex branch."
|
||||||
, com ""
|
, com ""
|
||||||
, com "Lines in this file have the format:"
|
, 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 "Repository trust configuration"
|
||||||
, com "(Valid trust levels: " ++
|
, com "(Valid trust levels: " ++
|
||||||
unwords (map showTrustLevel [Trusted .. DeadTrusted]) ++
|
unwords (map showTrustLevel [Trusted .. DeadTrusted]) ++
|
||||||
")"
|
")"
|
||||||
]
|
]
|
||||||
trust = map (\(t, u) -> line "trust" u $ showTrustLevel t) $
|
(\(t, u) -> line "trust" u $ showTrustLevel t)
|
||||||
sort $ map swap $ M.toList $ cfgTrustMap cfg
|
(\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted)
|
||||||
|
|
||||||
defaulttrust = map (\u -> pcom $ line "trust" u $ showTrustLevel SemiTrusted) $
|
groups = settings cfgGroupMap
|
||||||
missing cfgTrustMap
|
|
||||||
groupsintro =
|
|
||||||
[ ""
|
[ ""
|
||||||
, com "Repository groups"
|
, com "Repository groups"
|
||||||
, com "(Separate group names with spaces)"
|
, com "(Separate group names with spaces)"
|
||||||
]
|
]
|
||||||
groups = sort $ map (\(s, u) -> line "group" u $ unwords $ S.toList s) $
|
(\(s, u) -> line "group" u $ unwords $ S.toList s)
|
||||||
map swap $ M.toList $ cfgGroupMap cfg
|
(\u -> lcom $ line "group" u "")
|
||||||
defaultgroups = map (\u -> pcom $ line "group" u "") $
|
|
||||||
missing cfgGroupMap
|
|
||||||
|
|
||||||
preferredcontentintro =
|
preferredcontent = settings cfgPreferredContentMap
|
||||||
[ ""
|
[ ""
|
||||||
, com "Repository preferred contents"
|
, com "Repository preferred contents"
|
||||||
]
|
]
|
||||||
preferredcontent = sort $ map (\(s, u) -> line "preferred-content" u s) $
|
(\(s, u) -> line "preferred-content" u s)
|
||||||
map swap $ M.toList $ cfgPreferredContentMap cfg
|
(\u -> line "preferred-content" u "")
|
||||||
defaultpreferredcontent = map (\u -> pcom $ line "preferred-content" u "") $
|
|
||||||
missing cfgPreferredContentMap
|
|
||||||
|
|
||||||
line setting u value = unwords
|
settings field desc showvals showdefaults = concat
|
||||||
[ setting
|
[ desc
|
||||||
, showu u
|
, concatMap showvals $
|
||||||
, "="
|
sort $ map swap $ M.toList $ field cfg
|
||||||
, value
|
, concatMap (\u -> lcom $ showdefaults u) $
|
||||||
|
missing field
|
||||||
]
|
]
|
||||||
pcom s = "#" ++ s
|
|
||||||
showu u = fromMaybe (fromUUID u) $
|
line setting u value =
|
||||||
M.lookup u (cfgDescriptions cfg)
|
[ com $ "(" ++ (fromMaybe "" $ M.lookup u descs) ++ ")"
|
||||||
missing field = S.toList $ M.keysSet (cfgDescriptions cfg) `S.difference` M.keysSet (field cfg)
|
, 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,
|
{- If there's a parse error, returns a new version of the file,
|
||||||
- with the problem lines noted. -}
|
- with the problem lines noted. -}
|
||||||
|
@ -155,16 +147,14 @@ parseCfg curcfg = go [] curcfg . lines
|
||||||
parse l cfg
|
parse l cfg
|
||||||
| null l = Right cfg
|
| null l = Right cfg
|
||||||
| "#" `isPrefixOf` l = Right cfg
|
| "#" `isPrefixOf` l = Right cfg
|
||||||
| null setting || null repo' = Left "missing repository name"
|
| null setting || null u = Left "missing repository uuid"
|
||||||
| otherwise = case M.lookup repo' name2uuid of
|
| otherwise = handle cfg (toUUID u) setting value'
|
||||||
Nothing -> badval "repository" repo'
|
|
||||||
Just u -> handle cfg u setting value'
|
|
||||||
where
|
where
|
||||||
(setting, rest) = separate isSpace l
|
(setting, rest) = separate isSpace l
|
||||||
(repo, value) = separate (== '=') rest
|
(r, value) = separate (== '=') rest
|
||||||
value' = trimspace value
|
value' = trimspace value
|
||||||
repo' = reverse $ trimspace $
|
u = reverse $ trimspace $
|
||||||
reverse $ trimspace repo
|
reverse $ trimspace r
|
||||||
trimspace = dropWhile isSpace
|
trimspace = dropWhile isSpace
|
||||||
|
|
||||||
handle cfg u setting value
|
handle cfg u setting value
|
||||||
|
@ -184,9 +174,6 @@ parseCfg curcfg = go [] curcfg . lines
|
||||||
in Right $ cfg { cfgPreferredContentMap = m }
|
in Right $ cfg { cfgPreferredContentMap = m }
|
||||||
| otherwise = badval "setting" setting
|
| otherwise = badval "setting" setting
|
||||||
|
|
||||||
name2uuid = M.fromList $ map swap $
|
|
||||||
M.toList $ cfgDescriptions curcfg
|
|
||||||
|
|
||||||
showerr (Just msg, l) = [parseerr ++ msg, l]
|
showerr (Just msg, l) = [parseerr ++ msg, l]
|
||||||
showerr (Nothing, l)
|
showerr (Nothing, l)
|
||||||
-- filter out the header and parse error lines
|
-- filter out the header and parse error lines
|
||||||
|
|
7
debian/changelog
vendored
7
debian/changelog
vendored
|
@ -1,3 +1,10 @@
|
||||||
|
git-annex (3.20121011) UNRELEASED; urgency=low
|
||||||
|
|
||||||
|
* vicfg: New file format, avoids ambiguity with repos that have the same
|
||||||
|
description, or no description.
|
||||||
|
|
||||||
|
-- Joey Hess <joeyh@debian.org> Fri, 12 Oct 2012 22:46:08 -0400
|
||||||
|
|
||||||
git-annex (3.20121010) unstable; urgency=low
|
git-annex (3.20121010) unstable; urgency=low
|
||||||
|
|
||||||
* Renamed --ingroup to --inallgroup.
|
* Renamed --ingroup to --inallgroup.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue