From 88ec6eff154853bcfc5ac6b36267416775a1359d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Oct 2013 02:57:36 -0400 Subject: [PATCH] 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 | 63 ++++++++++++++++--- Assistant/WebApp/Types.hs | 6 ++ Assistant/WebApp/routes | 4 ++ Logs/Schedule.hs | 12 ++++ templates/configurators/fsck.cassius | 2 + templates/configurators/fsck.hamlet | 9 ++- templates/configurators/fsck/form.hamlet | 11 +--- .../configurators/fsck/formcontent.hamlet | 16 +++++ 8 files changed, 103 insertions(+), 20 deletions(-) create mode 100644 templates/configurators/fsck.cassius create mode 100644 templates/configurators/fsck/formcontent.hamlet 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)) +

+ Currently scheduled checks: + $forall check <- checks + ^{fsckForm False check}

-

- ^{form} + Add a check: + ^{fsckForm True defaultFsck} diff --git a/templates/configurators/fsck/form.hamlet b/templates/configurators/fsck/form.hamlet index 3ae62709a8..cca9a915ce 100644 --- a/templates/configurators/fsck/form.hamlet +++ b/templates/configurators/fsck/form.hamlet @@ -1,9 +1,2 @@ -#{msg} -

-

- Check this repository for # - ^{fvInput durationView} minutes # - starting at ^{fvInput timeView} - ^{fvInput recurranceView} -