From 57ba1c9e12a4e91d290444dc938aa44a2fbe1ef1 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 23 Mar 2019 23:00:32 +0100 Subject: [PATCH] Use wrapForm everywhere --- src/Auth/Dummy.hs | 9 +- src/Auth/LDAP.hs | 8 ++ src/Auth/PWHash.hs | 9 +- src/Handler/Admin.hs | 51 +++++++---- src/Handler/Corrections.hs | 38 +++++--- src/Handler/Course.hs | 10 ++- src/Handler/Home.hs | 27 ++++-- src/Handler/Profile.hs | 13 ++- src/Handler/Sheet.hs | 21 +++-- src/Handler/Submission.hs | 7 +- src/Handler/SystemMessage.hs | 57 +++++++----- src/Handler/Term.hs | 7 +- src/Handler/Users.hs | 16 +++- src/Handler/Utils/Delete.hs | 5 ++ src/Handler/Utils/Form.hs | 6 -- src/Handler/Utils/Table/Pagination.hs | 88 ++++++++++++------- src/Utils/Form.hs | 21 +++-- src/Utils/Route.hs | 5 +- templates/adminFeatures.hamlet | 3 +- templates/adminTest.hamlet | 3 +- templates/adminUser.hamlet | 4 +- templates/authpreds.hamlet | 5 +- templates/correction.hamlet | 6 +- templates/corrections-create.hamlet | 3 +- templates/corrections-upload.hamlet | 3 +- templates/course.hamlet | 5 +- templates/editTerm.hamlet | 17 ---- templates/formPage.hamlet | 5 -- templates/formPageI18n.hamlet | 8 -- templates/formPageI18n.julius | 21 ----- templates/help.hamlet | 6 +- templates/newCourse.hamlet | 20 ----- templates/sheetShow.hamlet | 3 +- templates/submission-assign.hamlet | 3 +- templates/submission-list.hamlet | 8 -- templates/submission.hamlet | 3 +- templates/system-message-list.hamlet | 3 +- templates/table/cell/header.hamlet | 4 +- templates/table/form-wrap.hamlet | 5 -- templates/table/layout-filter-default.hamlet | 5 +- templates/table/layout.hamlet | 5 +- .../campus-login/campus-login-form.hamlet | 3 +- .../widgets/data-delete/data-delete.hamlet | 53 ++++++----- .../delete-confirmation.hamlet | 3 +- .../dummy-login-form/dummy-login-form.hamlet | 3 +- templates/widgets/form/form.hamlet | 5 +- .../hash-login-form/hash-login-form.hamlet | 3 +- 47 files changed, 323 insertions(+), 293 deletions(-) delete mode 100644 templates/editTerm.hamlet delete mode 100644 templates/formPage.hamlet delete mode 100644 templates/formPageI18n.hamlet delete mode 100644 templates/formPageI18n.julius delete mode 100644 templates/newCourse.hamlet delete mode 100644 templates/submission-list.hamlet delete mode 100644 templates/table/form-wrap.hamlet diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index cdb8db1e8..2edb89350 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -24,7 +24,6 @@ dummyForm :: ( RenderMessage site FormMessage , Button site ButtonSubmit ) => AForm (HandlerT site IO) (CI Text) dummyForm = areq (selectField userList) (fslI MsgDummyIdent) Nothing - <* submitButton where userList = fmap mkOptionList . runDB $ map toOption <$> selectList [] [Asc UserIdent] toOption (Entity _ User{..}) = Option (CI.original userIdent) userIdent (CI.original userIdent) @@ -54,4 +53,12 @@ dummyLogin = AuthPlugin{..} apDispatch _ _ = notFound apLogin toMaster = do (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard dummyForm + let loginForm = wrapForm login FormSettings + { formMethod = POST + , formAction = Just . SomeRoute . toMaster $ PluginR "dummy" [] + , formEncoding = loginEnctype + , formAttrs = [] + , formSubmit = FormSubmit + , formAnchor = Just "login--dummy" :: Maybe Text + } $(widgetFile "widgets/dummy-login-form/dummy-login-form") diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 861c03620..45ced319f 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -105,6 +105,14 @@ campusLogin conf@LdapConf{..} pool = AuthPlugin{..} apDispatch _ _ = notFound apLogin toMaster = do (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard campusForm + let loginForm = wrapForm login FormSettings + { formMethod = POST + , formAction = Just . SomeRoute . toMaster $ PluginR "LDAP" [] + , formEncoding = loginEnctype + , formAttrs = [] + , formSubmit = FormSubmit + , formAnchor = Just "login--campus" :: Maybe Text + } $(widgetFile "widgets/campus-login/campus-login-form") data CampusUserException = CampusUserLdapError LdapPoolError diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs index 74c4e67a3..cc50b9415 100644 --- a/src/Auth/PWHash.hs +++ b/src/Auth/PWHash.hs @@ -33,7 +33,6 @@ hashForm :: ( RenderMessage site FormMessage hashForm = HashLogin <$> areq ciField (fslpI MsgPWHashIdent "Identifikation") Nothing <*> areq passwordField (fslpI MsgPWHashPassword "Passwort") Nothing - <* submitButton hashLogin :: ( YesodAuth site @@ -90,5 +89,13 @@ hashLogin pwHashAlgo = AuthPlugin{..} apDispatch _ _ = notFound apLogin toMaster = do (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard hashForm + let loginForm = wrapForm login FormSettings + { formMethod = POST + , formAction = Just . SomeRoute . toMaster $ PluginR "PWHash" [] + , formEncoding = loginEnctype + , formAttrs = [] + , formSubmit = FormSubmit + , formAnchor = Just "login--hash" :: Maybe Text + } $(widgetFile "widgets/hash-login-form/hash-login-form") diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 0507747ed..187392b7a 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -69,7 +69,6 @@ emailTestForm = (,) <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) Nothing ) ) - <* submitButton where toMailDateTimeFormat dt d t = \case SelFormatDateTime -> dt @@ -100,6 +99,11 @@ getAdminTestR, postAdminTestR :: Handler Html -- Demo Page. Referenzimplementier getAdminTestR = postAdminTestR postAdminTestR = do ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonCreate) + let btnForm = wrapForm btnWdgt def + { formAction = Just $ SomeRoute AdminTestR + , formEncoding = btnEnctype + , formSubmit = FormNoSubmit + } case btnResult of (FormSuccess CreateInf) -> addMessage Info "Informatik-Knopf gedrückt" (FormSuccess CreateMath) -> addMessage Warning "Knopf Mathematik erkannt" @@ -114,10 +118,11 @@ postAdminTestR = do return jId writeJobCtl $ JobCtlPerform jId - let emailWidget' = [whamlet| -
- ^{emailWidget} - |] + let emailWidget' = wrapForm emailWidget def + { formAction = Just . SomeRoute $ AdminTestR + , formEncoding = emailEnctype + , formAttrs = [("data-ajax-submit", "")] + } let demoFormAction (_i,_b,_d) = addMessage Info "All ok." @@ -208,19 +213,27 @@ postAdminTestR = do [whamlet|

Formular Demonstration|] wrapForm formWidget FormSettings - { formMethod = methodPost - , formAction = SomeRoute $ AdminTestR :#: FIDAdminDemo + { formMethod = POST + , formAction = Just . SomeRoute $ AdminTestR :#: FIDAdminDemo , formEncoding = formEnctype + , formAttrs = [] , formSubmit = FormSubmit , formAnchor = Just FIDAdminDemo } showDemoResult + miIdent <- newIdent + let miForm' = wrapForm miForm FormSettings + { formMethod = POST + , formAction = Just . SomeRoute $ AdminTestR :#: miIdent + , formEncoding = miEnc + , formAttrs = [] + , formSubmit = FormSubmit + , formAnchor = Just miIdent + } [whamlet|

Mass-Input - - ^{miForm} - ^{submitButtonView} + ^{miForm'} $case miResult $of FormMissing $of FormFailure errs @@ -237,19 +250,18 @@ getAdminErrMsgR, postAdminErrMsgR :: Handler Html getAdminErrMsgR = postAdminErrMsgR postAdminErrMsgR = do ((ctResult, ctView), ctEncoding) <- runFormPost . renderAForm FormStandard $ - (unTextarea <$> areq textareaField (fslpI MsgErrMsgCiphertext "Ciphertext") Nothing) - <* submitButton + unTextarea <$> areq textareaField (fslpI MsgErrMsgCiphertext "Ciphertext") Nothing plaintext <- formResultMaybe ctResult $ exceptT (\err -> Nothing <$ addMessageI Error err) (return . Just) . (encodedSecretBoxOpen :: Text -> ExceptT EncodedSecretBoxException Handler Value) + let ctView' = wrapForm ctView def{ formAction = Just . SomeRoute $ AdminErrMsgR, formEncoding = ctEncoding } defaultLayout [whamlet| $maybe t <- plaintext
           #{encodePrettyToTextBuilder t}
 
-      
-        ^{ctView}
+      ^{ctView'}
     |]
 
 
@@ -270,6 +282,11 @@ getAdminFeaturesR, postAdminFeaturesR :: Handler Html
 getAdminFeaturesR = postAdminFeaturesR
 postAdminFeaturesR = do
     ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonInferStudyTerms)
+    let btnForm = wrapForm btnWdgt def
+          { formAction = Just $ SomeRoute AdminFeaturesR
+          , formEncoding = btnEnctype
+          , formSubmit = FormNoSubmit
+          }
     (infConflicts,infAccepted) <- case btnResult of
       (FormSuccess ButtonInferStudyTerms) -> do
         (infConflicts,infAmbiguous,infRedundant,infAccepted) <- Candidates.inferHandler
@@ -340,8 +357,7 @@ postAdminFeaturesR = do
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
-          dbtParams     = def { dbParamsFormAddSubmit = True
-                              , dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studydegrees-table-wrapper" :: Text)
+          dbtParams     = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studydegrees-table-wrapper" :: Text)
                               }
           psValidator   = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
       in dbTable psValidator DBTable{..}
@@ -369,8 +385,7 @@ postAdminFeaturesR = do
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
-          dbtParams     = def { dbParamsFormAddSubmit = True
-                              , dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)
+          dbtParams     = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)
                               }
           psValidator   = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
       in dbTable psValidator DBTable{..}
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index ab0d737bb..9381e0829 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -347,7 +347,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
       { dbParamsFormMethod = POST
       , dbParamsFormAction = Just $ SomeRoute currentRoute
       , dbParamsFormAttrs = []
-      , dbParamsFormAddSubmit = True
+      , dbParamsFormSubmit = FormSubmit
       , dbParamsFormAdditional = \frag -> do
           (actionRes, action) <- multiAction actions Nothing
           return ((, mempty) . Last . Just <$> actionRes, toWidget frag <> action)
@@ -615,15 +615,21 @@ postCorrectionR tid ssh csh shn cid = do
                                 (fslpI MsgRatingPoints "Punktezahl")
                                 (Just submissionRatingPoints)
 
-      ((corrResult, corrForm), corrEncoding) <- runFormPost . identifyForm FIDcorrection . renderAForm FormStandard $ (,,)
+      ((corrResult, corrForm'), corrEncoding) <- runFormPost . identifyForm FIDcorrection . renderAForm FormStandard $ (,,)
         <$> areq checkBoxField (fslI MsgRatingDone) (Just $ submissionRatingDone Submission{..})
         <*> pointsForm
         <*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment))
-        <* submitButton
+      let corrForm = wrapForm corrForm' def
+            { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
+            , formEncoding = corrEncoding
+            }
 
-      ((uploadResult, uploadForm), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionUpload . renderAForm FormStandard $
+      ((uploadResult, uploadForm'), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionUpload . renderAForm FormStandard $
             areq (zipFileField True) (fslI MsgRatingFiles) Nothing
-        <*  submitButton
+      let uploadForm = wrapForm uploadForm' def
+            { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
+            , formEncoding = uploadEncoding
+            }
 
       case corrResult of
         FormMissing -> return ()
@@ -696,7 +702,6 @@ getCorrectionsUploadR = postCorrectionsUploadR
 postCorrectionsUploadR = do
   ((uploadRes, upload), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionsUpload . renderAForm FormStandard $
        areq (zipFileField True) (fslI MsgCorrUploadField) Nothing
-    <* submitButton
 
   case uploadRes of
     FormMissing -> return ()
@@ -713,8 +718,12 @@ postCorrectionsUploadR = do
               mr <- (toHtml .) <$> getMessageRender
               addMessage Success =<< withUrlRenderer ($(ihamletFile "templates/messages/correctionsUploaded.hamlet") mr)
 
+  let uploadForm = wrapForm upload def
+        { formAction = Just $ SomeRoute CorrectionsUploadR
+        , formEncoding = uploadEncoding
+        }
 
-  defaultLayout $
+  defaultLayout
     $(widgetFile "corrections-upload")
 
 getCorrectionsCreateR, postCorrectionsCreateR :: Handler Html
@@ -749,7 +758,6 @@ postCorrectionsCreateR = do
   ((pseudonymRes, pseudonymWidget), pseudonymEncoding) <- runFormPost . renderAForm FormStandard $ (,)
     <$> areq (selectField sheetOptions) (fslI MsgPseudonymSheet) Nothing
     <*> (textToList <$> areq textareaField (fslpI MsgCorrectionPseudonyms "Pseudonyme" & setTooltip MsgCorrectionPseudonymsTip) Nothing)
-    <* submitButton
 
   case pseudonymRes of
     FormMissing -> return ()
@@ -846,8 +854,12 @@ postCorrectionsCreateR = do
       when allDone $
         redirect CorrectionsGradeR
 
+  let pseudonymForm = wrapForm pseudonymWidget def
+        { formAction   = Just $ SomeRoute CorrectionsCreateR
+        , formEncoding = pseudonymEncoding
+        }
 
-  defaultLayout $
+  defaultLayout
     $(widgetFile "corrections-create")
   where
     partitionEithers' :: [[Either a b]] -> ([[b]], [a])
@@ -889,7 +901,6 @@ postCorrectionsGradeR = do
 
   (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns mempty psValidator dbtProj' $ def
     { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
-    , dbParamsFormAddSubmit = True
     }
 
   case tableRes of
@@ -927,9 +938,8 @@ postSAssignR tid ssh csh shn cID = do
 
   $logDebugS "SAssignR" $ tshow currentCorrector
   let correctorField  = selectField $ optionsPersistCryptoId [UserId <-. sheetCorrectors] [Asc UserSurname, Asc UserDisplayName] userDisplayName
-  ((corrResult, corrForm), corrEncoding) <- runFormPost . renderAForm FormStandard $
+  ((corrResult, corrForm'), corrEncoding) <- runFormPost . renderAForm FormStandard $
         aopt correctorField (fslI MsgCorrector) (Just currentCorrector)
-    <*  submitButton
   formResult corrResult $ \(fmap entityKey -> mbUserId) -> do
     when (mbUserId /= fmap entityKey currentCorrector) . runDB $ do
       now <- liftIO getCurrentTime
@@ -938,6 +948,10 @@ postSAssignR tid ssh csh shn cID = do
                   ]
       addMessageI Success MsgCorrectorUpdated
     redirect actionUrl
+  let corrForm = wrapForm corrForm' def
+        { formAction = Just $ SomeRoute actionUrl
+        , formEncoding = corrEncoding
+        }
   defaultLayout $ do
       setTitleI MsgCorrectorAssignTitle
       $(widgetFile "submission-assign")
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index bf779d136..bee19eaba 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -296,6 +296,11 @@ getCShowR tid ssh csh = do
   mDereg   <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
   mRegAt   <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
   (regWidget, regEnctype) <- generateFormPost $ registerForm mbAid registration defSFid $ courseRegisterSecret course
+  let regForm = wrapForm regWidget def
+        { formAction = Just . SomeRoute $ CourseR tid ssh csh CRegisterR
+        , formEncoding = regEnctype
+        , formSubmit = FormNoSubmit
+        }
   registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
   siteLayout (toWgt $ courseName course) $ do
     setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
@@ -521,7 +526,10 @@ courseEditHandler mbCourseForm = do
     actionUrl <- fromMaybe CourseNewR <$> getCurrentRoute
     defaultLayout $ do
       setTitleI MsgCourseEditTitle
-      $(widgetFile "formPage")
+      wrapForm formWidget def
+        { formAction = Just $ SomeRoute actionUrl
+        , formEncoding = formEnctype
+        }
 
 
 data CourseForm = CourseForm
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index b9579f26d..7b60a6da3 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -239,7 +239,6 @@ helpForm mReferer mUid = HelpForm
     <$> aopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer)
     <*> multiActionA (fslI MsgHelpAnswer) identActions (HIUser <$ mUid)
     <*> (unTextarea <$> areq textareaField (fslI MsgHelpRequest) Nothing)
-    <*  submitButton
   where
     identActions :: Map _ (AForm _ (Either (Maybe Address) UserId))
     identActions = Map.fromList $ case mUid of
@@ -256,8 +255,14 @@ getHelpR = postHelpR
 postHelpR = do
   mUid <- maybeAuthId
   mReferer <- flip formResultMaybe return <=< runInputGetResult $ iopt routeField (toPathPiece GetReferer)
+  isModal <- hasCustomHeader HeaderIsModal
 
   ((res,formWidget),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mReferer mUid
+  let form = wrapForm formWidget def
+        { formAction = Just $ SomeRoute HelpR
+        , formEncoding = formEnctype
+        , formAttrs = [ ("data-ajax-submit", "") | isModal ]
+        }
 
   formResultModal res HelpR $ \HelpForm{..} -> do
     now <- liftIO getCurrentTime
@@ -272,7 +277,6 @@ postHelpR = do
 
   defaultLayout $ do
     setTitleI MsgHelpTitle
-    isModal <- hasCustomHeader HeaderIsModal
     $(widgetFile "help")
 
 
@@ -295,14 +299,25 @@ postAuthPredsR = do
       | otherwise = fromMaybe False <$> aopt checkBoxField (fslI authTag) (Just . Just $ authTagCurrentActive authTag)
 
   ((authActiveRes, authActiveWidget), authActiveEnctype) <- runFormPost . renderAForm FormStandard
-    $ AuthTagActive
-      <$> (submitButton -- for convenience, avoids frequent scrolling
-      *>  funcForm taForm (fslI MsgActiveAuthTags) True)
-      <*  submitButton
+    $ AuthTagActive <$> funcForm taForm (fslI MsgActiveAuthTags) True
 
   mReferer <- runMaybeT $ do
     param <- MaybeT (lookupGetParam $ toPathPiece GetReferer) <|> MaybeT (lookupPostParam $ toPathPiece GetReferer)
     MaybeT . return $ fromPathPiece param
+
+  let authActiveForm = wrapForm authActiveWidget' def
+        { formAction = Just $ SomeRoute AuthPredsR
+        , formEncoding = authActiveEnctype
+        , formSubmit = FormDualSubmit
+        }
+      authActiveWidget'
+        = [whamlet|
+            $newline never
+            $maybe referer <- mReferer
+              
+            ^{authActiveWidget}
+          |]
+
   formResult authActiveRes $ \authTagActive -> do
     setSessionJson SessionActiveAuthTags authTagActive
     modifySessionJson SessionInactiveAuthTags . fmap $ Set.filter (not . authTagIsActive authTagActive)
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index c67b11abf..ea492e87b 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -43,7 +43,6 @@ makeSettingForm template = identifyForm FIDsettings $ \html -> do
                                 ) (stgDownloadFiles <$> template)
         <*  aformSection MsgFormNotifications
         <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
-        <*  submitButton
     return (result, widget) -- no validation required here
   where
     themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
@@ -115,11 +114,12 @@ postProfileR = do
     (FormFailure msgs) -> forM_ msgs $ addMessage Warning . toHtml
     _ -> return ()
 
-  let formText  = Nothing :: Maybe UniWorXMessage
-      actionUrl = ProfileR
   siteLayout [whamlet|_{MsgProfileFor} ^{nameWidget userDisplayName userSurname}|] $ do
     setTitle . toHtml $ "Profil " <> userIdent
-    $(widgetFile "formPageI18n")
+    wrapForm formWidget def
+      { formAction = Just $ SomeRoute ProfileR
+      , formEncoding = formEnctype
+      }
 
 postProfileDataR  :: Handler Html
 postProfileDataR = do
@@ -245,6 +245,11 @@ getProfileDataR = do
 
   -- Delete Button
   (btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form ButtonDelete)
+  let btnForm = wrapForm btnWdgt def
+        { formAction = Just $ SomeRoute ProfileDataR
+        , formEncoding = btnEnctype
+        , formSubmit = FormNoSubmit
+        }
   defaultLayout $ do
     let delWdgt = $(widgetFile "widgets/data-delete/data-delete")
     $(widgetFile "profileData")
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index c2c8136d1..e378a74d5 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -359,6 +359,11 @@ getSShowR tid ssh csh shn = do
     return $ review _PseudonymText sheetPseudonymPseudonym
   (generateWidget, generateEnctype) <- generateFormPost $ \csrf ->
     over _2 ((toWidget csrf <>) . fvInput) <$> mreq (buttonField BtnGenerate) "" Nothing
+  let generateForm = wrapForm generateWidget def
+        { formAction = Just . SomeRoute $ CSheetR tid ssh csh shn SPseudonymR
+        , formEncoding = generateEnctype
+        , formSubmit = FormNoSubmit
+        }
   defaultLayout $ do
     setTitleI $ MsgSheetTitle tid ssh csh shn
     sheetFrom    <-           formatTime SelFormatDateTime  $ sheetActiveFrom   sheet
@@ -559,11 +564,13 @@ handleSheetEdit tid ssh csh msId template dbAction = do
   let pageTitle = maybe (MsgSheetTitleNew tid ssh csh)
                         (MsgSheetTitle    tid ssh csh) mbshn
 --   let formTitle = pageTitle -- no longer used in template
-  let formText  = Nothing :: Maybe UniWorXMessage
   actionUrl <- fromMaybe (CourseR tid ssh csh SheetNewR) <$> getCurrentRoute
   defaultLayout $ do
     setTitleI pageTitle
-    $(widgetFile "formPageI18n")
+    wrapForm formWidget def
+      { formAction = Just $ SomeRoute actionUrl
+      , formEncoding = formEnctype
+      }
 
 
 getSDelR, postSDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
@@ -791,11 +798,9 @@ getSCorrR tid ssh csh shn = do
       addMessageI Success MsgCorrectorsUpdated
     FormMissing -> return ()
 
-  let
-    --     formTitle = MsgSheetCorrectorsTitle tid ssh csh shn
-    formText  = Nothing :: Maybe (SomeMessage UniWorX)
-    actionUrl = CSheetR tid ssh csh shn SCorrR
-    -- actionUrl = CSheetR tid ssh csh shn SShowR
   defaultLayout $ do
     setTitleI $ MsgSheetCorrectorsTitle tid ssh csh shn
-    $(widgetFile "formPageI18n")
+    wrapForm formWidget def
+      { formAction = Just . SomeRoute $ CSheetR tid ssh csh shn SCorrR
+      , formEncoding = formEnctype
+      }
diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index 6ce62d265..978f02672 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -64,7 +64,6 @@ makeSubmissionForm msmid uploadMode grouping (self :| buddies) = identifyForm FI
                                       | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
                                       ])
         )
-      <*  submitButton
   where
     (groupNr, editableBuddies)
       | Arbitrary{..} <- grouping = (maxParticipants, True)
@@ -169,7 +168,11 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
               return (userName, submissionEdit E.^. SubmissionEditTime)
             forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
         return (csheet,buddies,lastEdits)
-  ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping (userEmail userData :| buddies)
+  ((res,formWidget'), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping (userEmail userData :| buddies)
+  let formWidget = wrapForm formWidget' def
+        { formAction = Just $ SomeRoute actionUrl
+        , formEncoding = formEnctype
+        }
   mCID <- fmap join . msgSubmissionErrors . runDBJobs $ do
     res' <- case res of
       FormMissing              -> return   FormMissing
diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs
index 34ab467ac..de4f2a193 100644
--- a/src/Handler/SystemMessage.hs
+++ b/src/Handler/SystemMessage.hs
@@ -44,7 +44,6 @@ postMessageR cID = do
           <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just systemMessageDefaultLanguage)
           <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") (Just systemMessageContent)
           <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") (Just systemMessageSummary)
-          <* submitButton
 
       ts <- runDB $ selectList [ SystemMessageTranslationMessage ==. smId ] [Asc SystemMessageTranslationLanguage]
       let ts' = Map.fromList $ (systemMessageTranslationLanguage . entityVal &&& id) <$> ts
@@ -70,7 +69,6 @@ postMessageR cID = do
           <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") Nothing
           <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") Nothing
           <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") Nothing
-          <* submitButton
 
       formResult modifyRes $ modifySystemMessage smId
 
@@ -91,24 +89,39 @@ postMessageR cID = do
           redirect $ MessageR cID
 
       let
-        messageEditModal = modal [whamlet|_{MsgSystemMessageEdit}|] $ Right
-          [whamlet|
-            
-              ^{modifyView}
-          |]
-        translationAddModal = modal [whamlet|_{MsgSystemMessageAddTranslation}|] $ Right
-          [whamlet|
-            
-              ^{addTransView}
-          |]
+        messageEditModal = modal [whamlet|_{MsgSystemMessageEdit}|] . Right $
+          wrapForm modifyView FormSettings
+            { formMethod   = POST
+            , formAction   = Just . SomeRoute $ MessageR cID
+            , formEncoding = modifyEnctype
+            , formAttrs    = []
+            , formSubmit   = FormSubmit
+            , formAnchor   = Nothing :: Maybe Text
+            }
+        translationAddModal = modal [whamlet|_{MsgSystemMessageAddTranslation}|] . Right $
+          wrapForm addTransView FormSettings
+            { formMethod   = POST
+            , formAction   = Just . SomeRoute $ MessageR cID
+            , formEncoding = addTransEnctype
+            , formAttrs    = []
+            , formSubmit   = FormSubmit
+            , formAnchor   = Nothing :: Maybe Text
+            }
         translationsEditModal
-          | not $ null modifyTranss' = modal [whamlet|_{MsgSystemMessageEditTranslations}|] $ Right
-            [whamlet|
-              $forall ((_, transView), transEnctype) <- modifyTranss'
-                
- + | not $ null modifyTranss' = modal [whamlet|_{MsgSystemMessageEditTranslations}|] . Right $ do + let modifyTranss'' = flip map modifyTranss' $ \((_, transView), transEnctype) -> wrapForm transView FormSettings + { formMethod = POST + , formAction = Just . SomeRoute $ MessageR cID + , formEncoding = transEnctype + , formAttrs = [] + , formSubmit = FormNoSubmit + , formAnchor = Nothing :: Maybe Text + } + [whamlet| + $forall transView <- modifyTranss'' +
^{transView} - |] + |] | otherwise = mempty return (messageEditModal, translationAddModal, translationsEditModal) @@ -203,7 +216,7 @@ postMessageListR = do { dbParamsFormMethod = POST , dbParamsFormAction = Just $ SomeRoute MessageListR , dbParamsFormAttrs = [] - , dbParamsFormAddSubmit = True + , dbParamsFormSubmit = FormSubmit , dbParamsFormAdditional = \frag -> do now <- liftIO getCurrentTime let actions = Map.fromList @@ -255,7 +268,6 @@ postMessageListR = do <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just $ NonEmpty.head appLanguages) <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") Nothing <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") Nothing - <* submitButton case addRes of FormMissing -> return () @@ -266,5 +278,10 @@ postMessageListR = do addMessageI Success $ MsgSystemMessageAdded cID redirect $ MessageR cID + let addForm = wrapForm addView def + { formAction = Just $ SomeRoute MessageListR + , formEncoding = addEncoding + } + defaultLayout $(widgetFile "system-message-list") diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 784486f91..31ab90653 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -191,10 +191,12 @@ termEditHandler term = do redirect TermShowR FormMissing -> return () (FormFailure _) -> addMessageI Warning MsgInvalidInput - let actionUrl = TermEditR defaultLayout $ do setTitleI MsgTermEditHeading - $(widgetFile "formPage") + wrapForm formWidget def + { formAction = Just $ SomeRoute TermEditR + , formEncoding = formEnctype + } data TermFormTemplate = TermFormTemplate { tftName :: Maybe TermIdentifier @@ -253,7 +255,6 @@ newTermForm template html = do <*> areq dayField (fslI MsgTermLectureStart) (tftLectureStart template) <*> areq dayField (fslI MsgTermLectureEnd & setTooltip MsgTermLectureEndTooltip) (tftLectureEnd template) <*> areq checkBoxField (bfs ("Aktiv" :: Text)) (tftActive template) - <* submitButton return $ case result of FormSuccess termResult | errorMsgs <- validateTerm termResult diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 3fa72341f..5bd4c7ed6 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -71,10 +71,14 @@ getUsersR = do myUid <- liftHandlerT maybeAuthId when (mayHijack && Just uid /= myUid) $ do (hijackView, hijackEnctype) <- liftHandlerT . generateFormPost $ hijackUserForm cID - [whamlet| - - ^{hijackView} - |] + wrapForm hijackView FormSettings + { formMethod = POST + , formAction = Just . SomeRoute $ AdminHijackUserR cID + , formEncoding = hijackEnctype + , formAttrs = [] + , formSubmit = FormNoSubmit + , formAnchor = Nothing :: Maybe Text + } ] psValidator = def & defaultSorting [SortAscBy "name", SortAscBy "display-name"] @@ -202,6 +206,10 @@ postAdminUserR uuid = do queueJob' . JobQueueNotification $ NotificationUserRightsUpdate uid (over _1 (schoolShorthand . entityVal) <$> userRights) -- original rights to check for difference addMessageI Info MsgAccessRightsSaved ((result, formWidget),formEnctype) <- runFormPost userRightsForm + let form = wrapForm formWidget def + { formAction = Just . SomeRoute $ AdminUserR uuid + , formEncoding = formEnctype + } formResult result userRightsAction let heading = [whamlet|_{MsgAccessRightsFor} ^{nameWidget userDisplayName userSurname}|] diff --git a/src/Handler/Utils/Delete.hs b/src/Handler/Utils/Delete.hs index e98d7d98f..3f4937fb7 100644 --- a/src/Handler/Utils/Delete.hs +++ b/src/Handler/Utils/Delete.hs @@ -90,6 +90,11 @@ getDeleteR DeleteRoute{..} = do (deleteFormWdgt, deleteFormEnctype) <- generateFormPost $ confirmForm' drRecords confirmString Just targetRoute <- getCurrentRoute + let deleteForm = wrapForm deleteFormWdgt def + { formAction = Just $ SomeRoute targetRoute + , formEncoding = deleteFormEnctype + , formSubmit = FormNoSubmit + } sendResponse =<< defaultLayout $(widgetFile "widgets/delete-confirmation/delete-confirmation") diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 430772525..4be31478d 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -116,12 +116,6 @@ linkButton lbl cls url = do ^{lbl} |] --- [whamlet| --- --- ---