diff options
Diffstat (limited to 'Command/Vicfg.hs')
| -rw-r--r-- | Command/Vicfg.hs | 35 |
1 files changed, 27 insertions, 8 deletions
diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 1aa8722c5..22c641408 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -21,7 +21,9 @@ import Types.Group import Logs.Trust import Logs.Group import Logs.PreferredContent +import Logs.Schedule import Types.StandardGroups +import Types.ScheduledActivity import Remote def :: [Command] @@ -59,6 +61,7 @@ data Cfg = Cfg { cfgTrustMap :: TrustMap , cfgGroupMap :: M.Map UUID (S.Set Group) , cfgPreferredContentMap :: M.Map UUID String + , cfgScheduleMap :: M.Map UUID [ScheduledActivity] } getCfg :: Annex Cfg @@ -66,22 +69,25 @@ getCfg = Cfg <$> trustMapRaw -- without local trust overrides <*> (groupsByUUID <$> groupMap) <*> preferredContentMapRaw + <*> scheduleMap setCfg :: Cfg -> Cfg -> Annex () setCfg curcfg newcfg = do - let (trustchanges, groupchanges, preferredcontentchanges) = diffCfg curcfg newcfg + 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) -diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredContentMap) +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) 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] +genCfg cfg descs = unlines $ concat + [intro, trust, groups, preferredcontent, schedule] where intro = [ com "git-annex configuration" @@ -120,17 +126,25 @@ genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent] (\(s, u) -> line "content" u s) (\u -> line "content" u "") + schedule = settings 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 (\u -> lcom $ showdefaults u) $ missing field + , concatMap (lcom . showdefaults) $ missing field ] line setting u value = - [ com $ "(for " ++ (fromMaybe "" $ M.lookup u descs) ++ ")" + [ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")" , unwords [setting, fromUUID u, "=", value] ] - lcom = map (\l -> if "#" `isPrefixOf` l then l else "#" ++ l) + 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, @@ -139,7 +153,7 @@ parseCfg :: Cfg -> String -> Either String Cfg parseCfg curcfg = go [] curcfg . lines where go c cfg [] - | null (catMaybes $ map fst c) = Right cfg + | null (mapMaybe fst c) = Right cfg | otherwise = Left $ unlines $ badheader ++ concatMap showerr (reverse c) go c cfg (l:ls) = case parse (dropWhile isSpace l) cfg of @@ -173,6 +187,11 @@ parseCfg curcfg = go [] curcfg . lines Nothing -> let m = M.insert u value (cfgPreferredContentMap cfg) in Right $ cfg { cfgPreferredContentMap = 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 showerr (Just msg, l) = [parseerr ++ msg, l] |