diff --git a/Assistant/WebApp/Configurators/Fsck.hs b/Assistant/WebApp/Configurators/Fsck.hs
index bc43eeb26a..10a477c010 100644
--- a/Assistant/WebApp/Configurators/Fsck.hs
+++ b/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
diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs
index 618a8dece2..b98f7d8099 100644
--- a/Assistant/WebApp/Types.hs
+++ b/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
+
diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes
index e942b41e1c..0ad32811ee 100644
--- a/Assistant/WebApp/routes
+++ b/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
diff --git a/Logs/Schedule.hs b/Logs/Schedule.hs
index 7fc210c14d..35745b9f38 100644
--- a/Logs/Schedule.hs
+++ b/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
diff --git a/templates/configurators/fsck.cassius b/templates/configurators/fsck.cassius
new file mode 100644
index 0000000000..32aa5c0ddb
--- /dev/null
+++ b/templates/configurators/fsck.cassius
@@ -0,0 +1,2 @@
+input[type=number]
+ width: 5em
diff --git a/templates/configurators/fsck.hamlet b/templates/configurators/fsck.hamlet
index 3e2d60a6bb..e37fdde93c 100644
--- a/templates/configurators/fsck.hamlet
+++ b/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))
+