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.
This commit is contained in:
parent
c809f3d486
commit
bc649a35ba
9 changed files with 193 additions and 33 deletions
|
@ -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 $
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue