add schedule command

Mostly because it gives me an excuse and a hook to document the schedule
expression format.
This commit is contained in:
Joey Hess 2013-10-13 15:40:38 -04:00
parent a1040a38c5
commit 296e21b381
7 changed files with 109 additions and 15 deletions

50
Command/Schedule.hs Normal file
View file

@ -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

View file

@ -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" =
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
| 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]