add/remove/edit schedule UI working

Once I built the basic widget, it turned out to be rather easy to replicate
it once per scheduled activity and wire it all up to a fully working UI.

This does abuse yesod's form handling a bit, but I think it's ok.
And it would be nice to have it all ajax-y, so that saving one modified
form won't lose any modifications to other forms. But for now, a nice
simple 115 line of code implementation is a win.

This late night hack session commit was sponsored by Andrea Rota.

Assistant/WebApp/Configurators/Fsck.hs

@@ -11,6 +11,7 @@
 module Assistant.WebApp.Configurators.Fsck where
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 import qualified Data.Text as T
 import qualified Text.Hamlet as Hamlet
 
@@ -18,18 +19,44 @@ import Assistant.WebApp.Common
 import Types.ScheduledActivity
 import Utility.HumanTime
 import Utility.Scheduled
+import Logs.Schedule
+import Annex.UUID
 
-fsckForm :: ScheduledActivity -> Hamlet.Html -> MkMForm ScheduledActivity
-fsckForm (ScheduledSelfFsck (Schedule r t) d) msg = do
+{- This adds a form to the page. It does not handle posting of the form,
+ - because unlike a typical yesod form that posts using the same url
+ - that generated it, this form posts using one of two other routes. -}
+fsckForm :: Bool -> ScheduledActivity -> Widget
+fsckForm new activity = do
+	u <- liftAnnex getUUID
+	let action = if new
+		then AddActivityR u
+		else ChangeActivityR u activity
+	((res, form), enctype) <- liftH $ runFormPost $ fsckForm' new activity
+	case res of
+		FormSuccess _ -> noop
+		_ -> $(widgetFile "configurators/fsck/form")
+
+{- This does not display a form, but it does get it from a post, and run
+ - some Annex action on it. -}
+withFsckForm :: (ScheduledActivity -> Annex ()) -> Handler ()
+withFsckForm a = do
+	((res, _form), _enctype) <- runFormPost $ fsckForm' False defaultFsck
+	case res of
+		FormSuccess activity -> liftAnnex $ a activity
+		_ -> noop
+
+fsckForm' :: Bool -> ScheduledActivity -> Hamlet.Html -> MkMForm ScheduledActivity
+fsckForm' new activity@(ScheduledSelfFsck (Schedule r t) d) msg = do
 	(durationRes, durationView) <- mreq intField "" (Just $ durationSeconds d `quot` 60 )
 	(timeRes, timeView) <- mreq (selectFieldList times) "" (Just t)
 	(recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) "" (Just r)
 	let form = do
 		webAppFormAuthToken
-		$(widgetFile "configurators/fsck/form")
+		u <- liftAnnex getUUID
+		$(widgetFile "configurators/fsck/formcontent")
 	let formresult = ScheduledSelfFsck
 		<$> (Schedule <$> recurranceRes <*> timeRes)
-		<*> (Duration <$> durationRes)
+		<*> (Duration <$> ((60 *) <$> durationRes))
 	return (formresult, form)
   where
 	times :: [(Text, ScheduledTime)]
@@ -55,7 +82,7 @@ fsckForm (ScheduledSelfFsck (Schedule r t) d) msg = do
 	ensurevalue v desc l = case M.lookup v (M.fromList $ map (\(x,y) -> (y,x)) l) of
 		Just _ -> l
 		Nothing -> (desc, v) : l
-fsckForm (ScheduledRemoteFsck u s d) _msg = error "TODO"
+fsckForm' new (ScheduledRemoteFsck u s d) _msg = error "TODO"
 
 defaultFsck :: ScheduledActivity
 defaultFsck = ScheduledSelfFsck (Schedule Daily AnyTime) (Duration $ 60*60)
@@ -64,7 +91,25 @@ getConfigFsckR :: Handler Html
 getConfigFsckR = postConfigFsckR
 postConfigFsckR :: Handler Html
 postConfigFsckR = page "Consistency checks" (Just Configuration) $ do
-	((res, form), enctype) <- liftH $ runFormPost $ fsckForm defaultFsck
-	case res of
-		FormSuccess s -> error "TODO"
-		_ -> $(widgetFile "configurators/fsck")
+	checks <- liftAnnex $ S.toList <$> (scheduleGet =<< getUUID)
+	$(widgetFile "configurators/fsck")
+
+getRemoveActivityR :: UUID -> ScheduledActivity -> Handler Html
+getRemoveActivityR u activity = do
+	liftAnnex $ scheduleRemove u activity
+	redirect ConfigFsckR
+
+getAddActivityR :: UUID -> Handler Html
+getAddActivityR = postAddActivityR
+postAddActivityR :: UUID -> Handler Html
+postAddActivityR u = do
+	withFsckForm $ scheduleAdd u
+	redirect ConfigFsckR
+
+getChangeActivityR :: UUID -> ScheduledActivity -> Handler Html
+getChangeActivityR = postChangeActivityR
+postChangeActivityR :: UUID -> ScheduledActivity -> Handler Html
+postChangeActivityR u oldactivity = do
+	withFsckForm $ \newactivity -> scheduleChange u $
+			S.insert newactivity . S.delete oldactivity
+	redirect ConfigFsckR

Assistant/WebApp/Types.hs

@@ -23,6 +23,7 @@ import Utility.Yesod
 import Logs.Transfer
 import Utility.Gpg (KeyId)
 import Build.SysConfig (packageversion)
+import Types.ScheduledActivity
 
 import Yesod.Static
 import Text.Hamlet
@@ -211,3 +212,8 @@ instance PathPiece RepoSelector where
 instance PathPiece ThreadName where
 	toPathPiece = pack . show
 	fromPathPiece = readish . unpack
+
+instance PathPiece ScheduledActivity where
+	toPathPiece = pack . show
+	fromPathPiece = readish . unpack
+

Assistant/WebApp/routes

@@ -84,6 +84,10 @@
 /config/repository/delete/finish/#UUID FinishDeleteRepositoryR GET
 /config/repository/delete/here DeleteCurrentRepositoryR GET POST
 
+/config/activity/add/#UUID AddActivityR GET POST
+/config/activity/change/#UUID/#ScheduledActivity ChangeActivityR GET POST
+/config/activity/remove/#UUID/#ScheduledActivity RemoveActivityR GET
+
 /transfers/#NotificationId TransfersR GET
 /notifier/transfers NotifierTransfersR GET
 

Logs/Schedule.hs

@@ -8,6 +8,9 @@
 module Logs.Schedule (
 	scheduleLog,
 	scheduleSet,
+	scheduleAdd,
+	scheduleRemove,
+	scheduleChange,
 	scheduleGet,
 	scheduleMap,
 	getLastRunTimes,
@@ -46,6 +49,15 @@ scheduleGet u = do
 	m <- scheduleMap
 	return $ maybe S.empty S.fromList (M.lookup u m)
 
+scheduleRemove :: UUID -> ScheduledActivity -> Annex ()
+scheduleRemove u activity = scheduleChange u $ S.delete activity
+
+scheduleAdd :: UUID -> ScheduledActivity -> Annex ()
+scheduleAdd u activity = scheduleChange u $ S.insert activity
+
+scheduleChange :: UUID -> (S.Set ScheduledActivity -> S.Set ScheduledActivity) -> Annex ()
+scheduleChange u a = scheduleSet u . S.toList . a =<< scheduleGet u
+
 getLastRunTimes :: Annex (M.Map ScheduledActivity LocalTime)
 getLastRunTimes = do
 	f <- fromRepo gitAnnexScheduleState

templates/configurators/fsck.cassius

@@ -0,0 +1,2 @@
+input[type=number]
+  width: 5em

templates/configurators/fsck.hamlet

@@ -9,6 +9,11 @@
     Running the consistency check involves reading all the files in the #
     repository, which can take a long time if it's large. Running just a #
     little at a time will eventually check the whole repository.
+  $if (not (null checks))
     <p>
-    <form method="post" .form-inline enctype=#{enctype}>
-      ^{form}
+      Currently scheduled checks:
+      $forall check <- checks
+        ^{fsckForm False check}
+  <p>
+    Add a check:
+    ^{fsckForm True defaultFsck}

templates/configurators/fsck/form.hamlet

@@ -1,9 +1,2 @@
-#{msg}
-<p>
-  <div .input-prepend .input-append>
-    Check this repository for #
-    ^{fvInput durationView} minutes #
-    starting at ^{fvInput timeView}
-    ^{fvInput recurranceView}
-    <button type=submit .btn .btn-primary>
-      Add
+<form method="post" .form-inline enctype=#{enctype} action="@{action}">
+  ^{form}

templates/configurators/fsck/formcontent.hamlet

@@ -0,0 +1,16 @@
+#{msg}
+<p>
+  <div .input-prepend .input-append>
+    Check this repository for #
+    ^{fvInput durationView} minutes #
+    ^{fvInput recurranceView} #
+    starting at ^{fvInput timeView} #
+    $if new
+      <button type=submit .btn .btn-primary>
+        Add
+    $else
+      <button type=submit .btn>
+        Save
+      <a .btn href="@{RemoveActivityR u activity}">
+        Remove
+