diff options
| -rw-r--r-- | Command/Vicfg.hs | 31 | ||||
| -rw-r--r-- | Logs/Schedule.hs | 1 | ||||
| -rw-r--r-- | Types/ScheduledActivity.hs | 23 | ||||
| -rw-r--r-- | Utility/QuickCheck.hs | 3 | ||||
| -rw-r--r-- | Utility/Scheduled.hs | 1 |
5 files changed, 47 insertions, 12 deletions
diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index dfdcde134..c6fc5ffc9 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -12,6 +12,7 @@ import qualified Data.Set as S import System.Environment (getEnv) import Data.Tuple (swap) import Data.Char (isSpace) +import Data.Either import Common.Annex import Command @@ -21,7 +22,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 +62,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 +70,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,6 +127,14 @@ 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 $ intercalate "; " $ map fromScheduledActivity l) + (\u -> line "schedule" u "") + settings field desc showvals showdefaults = concat [ desc , concatMap showvals $ sort $ map swap $ M.toList $ field cfg @@ -173,6 +188,14 @@ parseCfg curcfg = go [] curcfg . lines Nothing -> let m = M.insert u value (cfgPreferredContentMap cfg) in Right $ cfg { cfgPreferredContentMap = m } + | setting == "schedule" = + let (bad, good) = partitionEithers $ + map parseScheduledActivity $ split "; " value + in if null bad + then + let m = M.insert u good (cfgScheduleMap cfg) + in Right $ cfg { cfgScheduleMap = m } + else Left $ intercalate "; " bad | otherwise = badval "setting" setting showerr (Just msg, l) = [parseerr ++ msg, l] diff --git a/Logs/Schedule.hs b/Logs/Schedule.hs index 213aceeed..8f4c8b93a 100644 --- a/Logs/Schedule.hs +++ b/Logs/Schedule.hs @@ -9,6 +9,7 @@ module Logs.Schedule ( scheduleLog, scheduleSet, scheduleGet, + scheduleMap, ) where import qualified Data.Map as M diff --git a/Types/ScheduledActivity.hs b/Types/ScheduledActivity.hs index e2b8d088a..7e76cadfe 100644 --- a/Types/ScheduledActivity.hs +++ b/Types/ScheduledActivity.hs @@ -14,18 +14,25 @@ import Types.UUID data ScheduledActivity = ScheduledSelfFsck Schedule | ScheduledRemoteFsck UUID Schedule + deriving (Eq, Show, Ord) fromScheduledActivity :: ScheduledActivity -> String fromScheduledActivity (ScheduledSelfFsck s) = - "fsck self at " ++ fromSchedule s + "fsck self " ++ fromSchedule s fromScheduledActivity (ScheduledRemoteFsck u s) = - "fsck " ++ fromUUID u ++ " at " ++ fromSchedule s + "fsck " ++ fromUUID u ++ fromSchedule s toScheduledActivity :: String -> Maybe ScheduledActivity -toScheduledActivity s = case words s of - ("fsck":"self":rest) -> ScheduledSelfFsck - <$> toSchedule (unwords rest) - ("fsck":u:rest) -> ScheduledRemoteFsck +toScheduledActivity = eitherToMaybe . parseScheduledActivity + +parseScheduledActivity :: String -> Either String ScheduledActivity +parseScheduledActivity s = case words s of + ("fsck":"self":rest) -> qualified $ ScheduledSelfFsck + <$> parseSchedule (unwords rest) + ("fsck":u:rest) -> qualified $ ScheduledRemoteFsck <$> pure (toUUID u) - <*> toSchedule (unwords rest) - _ -> Nothing + <*> parseSchedule (unwords rest) + _ -> qualified $ Left "unknown activity" + where + qualified (Left e) = Left $ e ++ " in \"" ++ s ++ "\"" + qualified v = v diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs index 078b10c8b..82af09f3d 100644 --- a/Utility/QuickCheck.hs +++ b/Utility/QuickCheck.hs @@ -43,3 +43,6 @@ instance Arbitrary FileOffset where nonNegative :: (Num a, Ord a) => Gen a -> Gen a nonNegative g = g `suchThat` (>= 0) + +positive :: (Num a, Ord a) => Gen a -> Gen a +positive g = g `suchThat` (> 0) diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs index d3c00d5d8..9e0eeab67 100644 --- a/Utility/Scheduled.hs +++ b/Utility/Scheduled.hs @@ -9,6 +9,7 @@ module Utility.Scheduled ( Schedule(..), Recurrance(..), TimeOfDay(..), + Duration(..), fromSchedule, toSchedule, parseSchedule, |