add schedule command

Mostly because it gives me an excuse and a hook to document the schedule
expression format.

Command/Schedule.hs

@@ -0,0 +1,50 @@
+{- git-annex command
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Schedule where
+
+import Common.Annex
+import Command
+import qualified Remote
+import Logs.Schedule
+import Types.ScheduledActivity
+
+import qualified Data.Set as S
+
+def :: [Command]
+def = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek
+	SectionSetup "get or set scheduled jobs"]
+
+seek :: [CommandSeek]
+seek = [withWords start]
+
+start :: [String] -> CommandStart
+start = parse
+  where
+  	parse (name:[]) = go name performGet
+	parse (name:expr:[]) = go name $ \uuid -> do
+		showStart "schedile" name
+		performSet expr uuid
+	parse _ = error "Specify a repository."
+
+	go name a = do
+		u <- Remote.nameToUUID name
+		next $ a u
+
+performGet :: UUID -> CommandPerform
+performGet uuid = do
+	s <- scheduleGet uuid
+	liftIO $ putStrLn $ intercalate "; " $ 
+		map fromScheduledActivity $ S.toList s
+	next $ return True
+
+performSet :: String -> UUID -> CommandPerform
+performSet expr uuid = case parseScheduledActivities expr of
+	Left e -> error $ "Parse error: " ++ e
+	Right l -> do
+		scheduleSet uuid l
+		next $ return True

Command/Vicfg.hs

@@ -12,7 +12,6 @@ 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
@@ -132,7 +131,7 @@ genCfg cfg descs = unlines $ concat
 		, com "Scheduled activities"
 		, com "(Separate multiple activities with \"; \")"
 		]
-		(\(l, u) -> line "schedule" u $ intercalate "; " $ map fromScheduledActivity l)
+		(\(l, u) -> line "schedule" u $ fromScheduledActivities l)
 		(\u -> line "schedule" u "")
 
 	settings field desc showvals showdefaults = concat
@@ -188,14 +187,11 @@ parseCfg curcfg = go [] curcfg . lines
 				Nothing ->
 					let m = M.insert u value (cfgPreferredContentMap cfg)
 					in Right $ cfg { cfgPreferredContentMap = m }
-		| setting == "schedule" =
+		| setting == "schedule" = case parseScheduledActivities value of
-			let (bad, good) = partitionEithers $ 
+			Left e -> Left e
-				map parseScheduledActivity $ split "; " value
+			Right l -> 
-			in if null bad
+				let m = M.insert u l (cfgScheduleMap cfg)
-				then 
+				in Right $ cfg { cfgScheduleMap = m }
-					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]

GitAnnex.hs

@@ -54,6 +54,7 @@ import qualified Command.Semitrust
 import qualified Command.Dead
 import qualified Command.Group
 import qualified Command.Content
+import qualified Command.Schedule
 import qualified Command.Ungroup
 import qualified Command.Vicfg
 import qualified Command.Sync
@@ -117,6 +118,7 @@ cmds = concat
 	, Command.Dead.def
 	, Command.Group.def
 	, Command.Content.def
+	, Command.Schedule.def
 	, Command.Ungroup.def
 	, Command.Vicfg.def
 	, Command.FromKey.def

Logs/Schedule.hs

@@ -34,7 +34,7 @@ scheduleSet uuid@(UUID _) activities = do
 	Annex.Branch.change scheduleLog $
 		showLog id . changeLog ts uuid val . parseLog Just
   where
-  	val = intercalate "; " $ map fromScheduledActivity activities
+  	val = fromScheduledActivities activities
 scheduleSet NoUUID _ = error "unknown UUID; cannot modify"
 
 scheduleMap :: Annex (M.Map UUID [ScheduledActivity])
@@ -42,7 +42,7 @@ scheduleMap = simpleMap
 	. parseLogWithUUID parser
 	<$> Annex.Branch.get scheduleLog
   where
-	parser _uuid = Just . mapMaybe toScheduledActivity . split "; "
+	parser _uuid = eitherToMaybe . parseScheduledActivities
 
 scheduleGet :: UUID -> Annex (S.Set ScheduledActivity)
 scheduleGet u = do

Types/ScheduledActivity.hs

@@ -12,6 +12,8 @@ import Utility.Scheduled
 import Utility.HumanTime
 import Types.UUID
 
+import Data.Either
+
 data ScheduledActivity 
 	= ScheduledSelfFsck Schedule Duration
 	| ScheduledRemoteFsck UUID Schedule Duration
@@ -48,3 +50,14 @@ parseScheduledActivity s = case words s of
 	qualified (Left e) = Left $ e ++ " in \"" ++ s ++ "\""
 	qualified v = v
 	getduration d = maybe (Left $ "failed to parse duration \""++d++"\"") Right (parseDuration d)
+
+fromScheduledActivities :: [ScheduledActivity] -> String
+fromScheduledActivities = intercalate "; " . map fromScheduledActivity
+
+parseScheduledActivities :: String -> Either String [ScheduledActivity]
+parseScheduledActivities s
+	| null bad = Right good
+	| otherwise = Left $ intercalate "; " bad
+  where
+	(bad, good) = partitionEithers $
+		map parseScheduledActivity $ split "; " s

debian/changelog

@@ -1,5 +1,8 @@
 git-annex (4.20131003) UNRELEASED; urgency=low
 
+  * The assitant can now run scheduled incremental fsck jobs on the local
+    repository and remotes. These can be configured using vicfg or with the
+    webapp.
   * Automatically and safely detect and recover from dangling
     .git/annex/index.lock files, which would prevent git from
     committing to the git-annex branch, eg after a crash.

doc/git-annex.mdwn

@@ -410,6 +410,12 @@ subdirectories).
   Without an expression, displays the current preferred content setting
   of the repository.
 
+* `schedule repository [expression]`
+
+  When run with an expression, configures scheduled jobs to run at a
+  particular time. This can be used to make the assistant periodically run
+  incremental fscks. See SCHEDULED JOBS below.
+
 * `vicfg`
 
   Opens EDITOR on a temp file containing most of the above configuration
@@ -935,8 +941,8 @@ file contents are present at either of two repositories.
 
 Each repository has a preferred content setting, which specifies content
 that the repository wants to have present. These settings can be configured
-using `git annex vicfg`. They are used by the `--auto` option, and
+using `git annex vicfg` or `git annex content`.
-by the git-annex assistant.
+They are used by the `--auto` option, and by the git-annex assistant.
 
 The preferred content settings are similar, but not identical to
 the file matching options specified above, just without the dashes.
@@ -952,7 +958,31 @@ When a repository is in one of the standard predefined groups, like "backup"
 and "client", setting its preferred content to "standard" will use a
 built-in preferred content expression ddeveloped for that group.
 
-# CONFIGURATION
+# SCHEDULED JOBS
+
+The git-annex assistant daemon can be configured to run jobs at scheduled
+times. This is similar to cron (and you can use cron if you prefer), but
+has the advantage of being integrated into git-annex, and so being able
+to eg, fsck a repository on a removable drive when the drive gets
+connected.
+
+The scheduled jobs can be configured using `git annex vicfg` or
+`git annex schedule`. 
+
+These actions are available: "fsck self", "fsck UUID" (where UUID
+is the UUID of a remote to fsck). After the action comes the duration
+to allow the action to run, and finally the schedule of when to run it.
+
+To schedule multiple jobs, separate them with "; ".
+
+Some examples:
+
+	fsck self 30m every day at any time
+	fsck self 1h every day at 3 AM
+	fsck self 1h on day 1 of every month at any time
+	fsck self 1h on day 1 of weeks divisible by 2 at any time
+
+# CONFIGURATION VIA .git/config
 
 Like other git commands, git-annex is configured via `.git/config`.
 Here are all the supported configuration settings.