make git annex config settings editable in vicfg

This commit was sponsored by Shane-o on Patreon.
This commit is contained in:
Joey Hess 2017-01-30 17:08:05 -04:00
parent 339464e847
commit 183f3f7a9c
No known key found for this signature in database
GPG key ID: C910D9222512E3C7

View file

@ -24,6 +24,7 @@ import Logs.Trust
import Logs.Group import Logs.Group
import Logs.PreferredContent import Logs.PreferredContent
import Logs.Schedule import Logs.Schedule
import Logs.Config
import Logs.NumCopies import Logs.NumCopies
import Types.StandardGroups import Types.StandardGroups
import Types.ScheduledActivity import Types.ScheduledActivity
@ -68,6 +69,7 @@ data Cfg = Cfg
, cfgRequiredContentMap :: M.Map UUID PreferredContentExpression , cfgRequiredContentMap :: M.Map UUID PreferredContentExpression
, cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression , cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression
, cfgScheduleMap :: M.Map UUID [ScheduledActivity] , cfgScheduleMap :: M.Map UUID [ScheduledActivity]
, cfgGlobalConfigs :: M.Map ConfigName ConfigValue
, cfgNumCopies :: Maybe NumCopies , cfgNumCopies :: Maybe NumCopies
} }
@ -79,6 +81,7 @@ getCfg = Cfg
<*> requiredContentMapRaw <*> requiredContentMapRaw
<*> groupPreferredContentMapRaw <*> groupPreferredContentMapRaw
<*> scheduleMap <*> scheduleMap
<*> loadGlobalConfig
<*> getGlobalNumCopies <*> getGlobalNumCopies
setCfg :: Cfg -> Cfg -> Annex () setCfg :: Cfg -> Cfg -> Annex ()
@ -90,6 +93,7 @@ setCfg curcfg newcfg = do
mapM_ (uncurry requiredContentSet) $ M.toList $ cfgRequiredContentMap diff mapM_ (uncurry requiredContentSet) $ M.toList $ cfgRequiredContentMap diff
mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff
mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff
mapM_ (uncurry setGlobalConfig) $ M.toList $ cfgGlobalConfigs diff
maybe noop setGlobalNumCopies $ cfgNumCopies diff maybe noop setGlobalNumCopies $ cfgNumCopies diff
{- Default config has all the keys from the input config, but with their {- Default config has all the keys from the input config, but with their
@ -102,6 +106,7 @@ defCfg curcfg = Cfg
, cfgRequiredContentMap = mapdef $ cfgRequiredContentMap curcfg , cfgRequiredContentMap = mapdef $ cfgRequiredContentMap curcfg
, cfgGroupPreferredContentMap = mapdef $ cfgGroupPreferredContentMap curcfg , cfgGroupPreferredContentMap = mapdef $ cfgGroupPreferredContentMap curcfg
, cfgScheduleMap = mapdef $ cfgScheduleMap curcfg , cfgScheduleMap = mapdef $ cfgScheduleMap curcfg
, cfgGlobalConfigs = mapdef $ cfgGlobalConfigs curcfg
, cfgNumCopies = Nothing , cfgNumCopies = Nothing
} }
where where
@ -116,6 +121,7 @@ diffCfg curcfg newcfg = Cfg
, cfgRequiredContentMap = diff cfgRequiredContentMap , cfgRequiredContentMap = diff cfgRequiredContentMap
, cfgGroupPreferredContentMap = diff cfgGroupPreferredContentMap , cfgGroupPreferredContentMap = diff cfgGroupPreferredContentMap
, cfgScheduleMap = diff cfgScheduleMap , cfgScheduleMap = diff cfgScheduleMap
, cfgGlobalConfigs = diff cfgGlobalConfigs
, cfgNumCopies = cfgNumCopies newcfg , cfgNumCopies = cfgNumCopies newcfg
} }
where where
@ -132,7 +138,8 @@ genCfg cfg descs = unlines $ intercalate [""]
, standardgroups , standardgroups
, requiredcontent , requiredcontent
, schedule , schedule
, others , numcopies
, globalconfigs
] ]
where where
intro = intro =
@ -205,6 +212,14 @@ genCfg cfg descs = unlines $ intercalate [""]
(\(l, u) -> line "schedule" u $ fromScheduledActivities l) (\(l, u) -> line "schedule" u $ fromScheduledActivities l)
(\u -> line "schedule" u "") (\u -> line "schedule" u "")
globalconfigs = settings' cfg S.empty cfgGlobalConfigs
[ com "Other global configuration"
]
(\(s, g) -> gline g s)
(\g -> gline g "")
where
gline g val = [ unwords ["config", g, "=", val] ]
line setting u val = line setting u val =
[ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")" [ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")"
, unwords [setting, fromUUID u, "=", val] , unwords [setting, fromUUID u, "=", val]
@ -213,8 +228,8 @@ genCfg cfg descs = unlines $ intercalate [""]
line' setting Nothing = com $ unwords [setting, "default", "="] line' setting Nothing = com $ unwords [setting, "default", "="]
line' setting (Just val) = unwords [setting, "default", "=", val] line' setting (Just val) = unwords [setting, "default", "=", val]
others = numcopies =
[ com "Other configuration" [ com "Numcopies configuration"
, line' "numcopies" (show . fromNumCopies <$> cfgNumCopies cfg) , line' "numcopies" (show . fromNumCopies <$> cfgNumCopies cfg)
] ]
@ -290,6 +305,9 @@ parseCfg defcfg = go [] defcfg . lines
Right l -> Right l ->
let m = M.insert u l (cfgScheduleMap cfg) let m = M.insert u l (cfgScheduleMap cfg)
in Right $ cfg { cfgScheduleMap = m } in Right $ cfg { cfgScheduleMap = m }
| setting == "config" =
let m = M.insert f val (cfgGlobalConfigs cfg)
in Right $ cfg { cfgGlobalConfigs = m }
| setting == "numcopies" = case readish val of | setting == "numcopies" = case readish val of
Nothing -> Left "parse error (expected an integer)" Nothing -> Left "parse error (expected an integer)"
Just n -> Right $ cfg { cfgNumCopies = Just (NumCopies n) } Just n -> Right $ cfg { cfgNumCopies = Just (NumCopies n) }