add schedule to vicfg

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 :: 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)
+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]

Logs/Schedule.hs

@@ -9,6 +9,7 @@ module Logs.Schedule (
 	scheduleLog,
 	scheduleSet,
 	scheduleGet,
+	scheduleMap,
 ) where
 
 import qualified Data.Map as M

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
+toScheduledActivity = eitherToMaybe . parseScheduledActivity
-	("fsck":"self":rest) -> ScheduledSelfFsck
+
-		<$> toSchedule (unwords rest)
+parseScheduledActivity :: String -> Either String ScheduledActivity
-	("fsck":u:rest) -> ScheduledRemoteFsck
+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)
+		<*> parseSchedule (unwords rest)
-	_ -> Nothing
+	_ -> qualified $ Left "unknown activity"
+  where
+	qualified (Left e) = Left $ e ++ " in \"" ++ s ++ "\""
+	qualified v = v

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)

Utility/Scheduled.hs

@@ -9,6 +9,7 @@ module Utility.Scheduled (
 	Schedule(..),
 	Recurrance(..),
 	TimeOfDay(..),
+	Duration(..),
 	fromSchedule,
 	toSchedule,
 	parseSchedule,