Merge branch 'master' into course-teaser

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")

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

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")
 

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
@@ -83,7 +82,8 @@ makeDemoForm n = identifyForm ("adminTestForm" :: Text) $ \html -> do
         <*  aformSection MsgFormBehaviour
         <*> areq checkBoxField "Muss nächste Zahl größer sein?" (Just True)
         <*> areq doubleField "Fliesskommazahl" Nothing
-        <*  submitButton
+        -- NO LONGER DESIRED IN AFORMS:
+        -- <*  submitButton
     return $ case result of
       FormSuccess fsres
         | errorMsgs <- validateResult fsres
@@ -99,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"
@@ -113,16 +118,16 @@ postAdminTestR = do
       return jId
     writeJobCtl $ JobCtlPerform jId
 
-  let emailWidget' = [whamlet|
+  let emailWidget' = wrapForm emailWidget def
-        <form method=post action=@{AdminTestR} enctype=#{emailEnctype} data-ajax-submit>
+        { formAction = Just . SomeRoute $ AdminTestR
-          ^{emailWidget}
+        , formEncoding = emailEnctype
-      |]
+        , formAttrs = [("data-ajax-submit", "")]
+        }
 
 
   let demoFormAction (_i,_b,_d) = addMessage Info "All ok."
   ((demoResult, formWidget),formEnctype) <- runFormPost $ makeDemoForm 7
   formResult demoResult demoFormAction
-  let actionUrl = AdminTestR
   let showDemoResult = [whamlet|
           $maybe (i,b,d) <- formResult' demoResult
             Received values:
@@ -196,7 +201,6 @@ postAdminTestR = do
     allowAdd _ _ l = l < 7 -- Limit list length; much more complicated checks are possible (this could in principle be monadic, but @massInput@ is probably already complicated enough to cover just current (2019-03) usecases)
 
   -- The actual call to @massInput@ is comparatively simple:
-
   ((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd) "" True Nothing
 
 
@@ -207,14 +211,28 @@ postAdminTestR = do
     $(widgetFile "adminTest")
 
     [whamlet|<h2>Formular Demonstration|]
-    $(widgetFile "formPage")
+    wrapForm formWidget FormSettings
+      { 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|
       <h2>Mass-Input
-      <form enctype=#{miEnc} method=POST>
+      ^{miForm'}
-        ^{miForm}
-        ^{submitButtonView}
       $case miResult
         $of FormMissing
         $of FormFailure errs
@@ -231,19 +249,18 @@ getAdminErrMsgR, postAdminErrMsgR :: Handler Html
 getAdminErrMsgR = postAdminErrMsgR
 postAdminErrMsgR = do
   ((ctResult, ctView), ctEncoding) <- runFormPost . renderAForm FormStandard $
-        (unTextarea <$> areq textareaField (fslpI MsgErrMsgCiphertext "Ciphertext") Nothing)
+        unTextarea <$> areq textareaField (fslpI MsgErrMsgCiphertext "Ciphertext") Nothing
-    <*  submitButton
 
   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
         <pre style="white-space:pre-wrap; font-family:monospace">
           #{encodePrettyToTextBuilder t}
 
-      <form action=@{AdminErrMsgR} method=post enctype=#{ctEncoding}>
+      ^{ctView'}
-        ^{ctView}
     |]
 
 
@@ -264,6 +281,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
@@ -334,8 +356,7 @@ postAdminFeaturesR = do
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
-          dbtParams     = def { dbParamsFormAddSubmit = True
+          dbtParams     = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studydegrees-table-wrapper" :: Text)
-                              , dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studydegrees-table-wrapper" :: Text)
                               }
           psValidator   = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
       in dbTable psValidator DBTable{..}
@@ -363,8 +384,7 @@ postAdminFeaturesR = do
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
-          dbtParams     = def { dbParamsFormAddSubmit = True
+          dbtParams     = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)
-                              , dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)
                               }
           psValidator   = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
       in dbTable psValidator DBTable{..}

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")

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

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
+    $ AuthTagActive <$> funcForm taForm (fslI MsgActiveAuthTags) True
-      <$> (submitButton -- for convenience, avoids frequent scrolling
-      *>  funcForm taForm (fslI MsgActiveAuthTags) True)
-      <*  submitButton
 
   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
+              <input type=hidden name=#{toPathPiece GetReferer} value=#{toPathPiece referer}>
+            ^{authActiveWidget}
+          |]
+
   formResult authActiveRes $ \authTagActive -> do
     setSessionJson SessionActiveAuthTags authTagActive
     modifySessionJson SessionInactiveAuthTags . fmap $ Set.filter (not . authTagIsActive authTagActive)

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")

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
+      }

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

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
+        messageEditModal = modal [whamlet|_{MsgSystemMessageEdit}|] . Right $
-          [whamlet|
+          wrapForm modifyView FormSettings
-            <form method=post action=@{MessageR cID} enctype=#{modifyEnctype}>
+            { formMethod   = POST
-              ^{modifyView}
+            , formAction   = Just . SomeRoute $ MessageR cID
-          |]
+            , formEncoding = modifyEnctype
-        translationAddModal = modal [whamlet|_{MsgSystemMessageAddTranslation}|] $ Right
+            , formAttrs    = []
-          [whamlet|
+            , formSubmit   = FormSubmit
-            <form method=post action=@{MessageR cID} enctype=#{addTransEnctype}>
+            , formAnchor   = Nothing :: Maybe Text
-              ^{addTransView}
+            }
-          |]
+        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
+          | not $ null modifyTranss' = modal [whamlet|_{MsgSystemMessageEditTranslations}|] . Right $ do
-            [whamlet|
+              let modifyTranss'' = flip map modifyTranss' $ \((_, transView), transEnctype) -> wrapForm transView FormSettings
-              $forall ((_, transView), transEnctype) <- modifyTranss'
+                    { formMethod   = POST
-                <section>
+                    , formAction   = Just . SomeRoute $ MessageR cID
-                  <form method=post action=@{MessageR cID} enctype=#{transEnctype}>
+                    , formEncoding = transEnctype
+                    , formAttrs    = []
+                    , formSubmit   = FormNoSubmit
+                    , formAnchor   = Nothing :: Maybe Text
+                    }
+              [whamlet|
+                $forall transView <- modifyTranss''
+                  <section>
                     ^{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")

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

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|
+            wrapForm hijackView FormSettings
-              <form method=POST action=@{AdminHijackUserR cID} enctype=#{hijackEnctype}>
+              { formMethod   = POST
-                ^{hijackView}
+              , 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}|]

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")

src/Handler/Utils/Form.hs

@@ -45,6 +45,7 @@ import Utils.Lens
 import Data.Aeson (eitherDecodeStrict')
 import Data.Aeson.Text (encodeToLazyText)
 
+
 ----------------------------
 -- Buttons (new version ) --
 ----------------------------
@@ -115,12 +116,6 @@ linkButton lbl cls url = do
     <a href=#{url'} class=#{unwords $ map toPathPiece cls} role=button>
       ^{lbl}
   |]
---   [whamlet|
---     <form method=post action=@{url}>
---       <input type="hidden" name="_formid" value="identify-linkButton">
---       <button .btn .#{bcc2txt cls} type=submit value="Link to @{url}">^{lbl}
---   |]
-  --  <input .btn .#{bcc2txt cls} type="submit" value=^{lbl}>
 
 
 -- buttonForm :: (Button UniWorX a, Finite a) => Markup -> MForm (HandlerT UniWorX IO) (FormResult a, Widget)

src/Handler/Utils/Table/Pagination.hs

@@ -43,8 +43,6 @@ import qualified Database.Esqueleto.Utils as E
 import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect,unsafeSqlValue)
 import qualified Database.Esqueleto.Internal.Language as E (From)
 
-import qualified Data.Binary.Builder as Builder
-
 import qualified Network.Wai as Wai
 
 import Control.Monad.RWS hiding ((<>), mapM_)
@@ -331,7 +329,7 @@ data DBStyle = DBStyle
   , dbsAttrs :: [(Text, Text)]
   , dbsFilterLayout :: Widget
                     -> Enctype
-                    -> Text
+                    -> SomeRoute UniWorX
                     -> Widget
                     -> Widget
     -- ^ Filter UI, Filter Encoding, Filter action, table
@@ -352,10 +350,20 @@ instance Default DBStyle where
 
 defaultDBSFilterLayout :: Widget -- ^ Filter UI
                        -> Enctype
-                       -> Text -- ^ Filter action (target uri)
+                       -> SomeRoute UniWorX -- ^ Filter action (target uri)
                        -> Widget -- ^ Table
                        -> Widget
-defaultDBSFilterLayout filterWgdt filterEnctype filterAction scrolltable = $(widgetFile "table/layout-filter-default")
+defaultDBSFilterLayout filterWdgt filterEnctype filterAction scrolltable
+  = $(widgetFile "table/layout-filter-default")
+  where
+    filterForm = wrapForm filterWdgt FormSettings
+      { formMethod   = GET
+      , formAction   = Just filterAction
+      , formEncoding = filterEnctype
+      , formAttrs    = [("class", "table-filter-form")]
+      , formSubmit   = FormAutoSubmit
+      , formAnchor   = Nothing :: Maybe Text
+      }
 
 
 singletonFilter :: Ord k => k -> Prism' (Map k [v]) (Maybe v)
@@ -366,6 +374,18 @@ singletonFilter key = prism' fromInner (fmap Just . fromOuter)
       fromOuter = Map.lookup key >=> listToMaybe
 
 
+data WithIdent x = forall ident. PathPiece ident => WithIdent { _ident :: ident, _withoutIdent :: x }
+
+instance PathPiece x => PathPiece (WithIdent x) where
+  toPathPiece (WithIdent ident x)
+    | not . null $ toPathPiece ident = toPathPiece ident <> "-" <> toPathPiece x
+    | otherwise = toPathPiece x
+  fromPathPiece txt = do
+    let sep = "-"
+    (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt
+    WithIdent <$> pure ident <*> fromPathPiece rest
+
+
 data DBTable m x = forall a r r' h i t k k'.
   ( ToSortable h, Functor h
   , E.SqlSelect a r, E.SqlIn k k', DBTableKey k'
@@ -384,7 +404,7 @@ data DBTable m x = forall a r r' h i t k k'.
   , dbtIdent :: i
   }
 
-class (MonadHandler m, Monoid x, Monoid (DBCell m x), Default (DBParams m x)) => IsDBTable (m :: * -> *) (x :: *) where
+class (MonadHandler m, HandlerSite m ~ UniWorX, Monoid x, Monoid (DBCell m x), Default (DBParams m x)) => IsDBTable (m :: * -> *) (x :: *) where
   data DBParams m x :: *
   type DBResult m x :: *
   -- type DBResult' m x :: *
@@ -477,7 +497,7 @@ instance Monoid x => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc
     { dbParamsFormMethod     :: StdMethod
     , dbParamsFormAction     :: Maybe (SomeRoute UniWorX)
     , dbParamsFormAttrs      :: [(Text, Text)]
-    , dbParamsFormAddSubmit  :: Bool
+    , dbParamsFormSubmit     :: FormSubmitType
     , dbParamsFormAdditional :: Form a
     , dbParamsFormEvaluate   :: forall m' a' x'. (MonadHandler m', HandlerSite m' ~ UniWorX, MonadResource m') => (Html -> MForm (HandlerT UniWorX IO) (FormResult a', x')) -> m' ((FormResult a', x'), Enctype)
     , dbParamsFormResult     :: Lens' x (FormResult a)
@@ -508,7 +528,7 @@ instance Monoid x => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc
     = fmap ((\(res, (wdgt, x)) -> (x & dbParamsFormResult .~ res, wdgt)) . view _1)
     . dbParamsFormEvaluate
     . fmap (fmap $ \(x, wdgt) -> (x ^. dbParamsFormResult, (wdgt, x)))
-    . dbParamsFormWrap dbtParams
+    . dbParamsFormWrap dbtable dbtParams
     . maybe id (identifyForm' dbParamsFormResult) (unDBParamsFormIdent dbtable dbParamsFormIdent)
     . addPIHiddenField dbtable pi
     . addPreviousHiddenField dbtable pKeys
@@ -526,37 +546,26 @@ instance Monoid x => Default (DBParams (RWST (Maybe (Env, FileEnv), UniWorX, [La
     { dbParamsFormMethod     = POST
     , dbParamsFormAction     = Nothing
     , dbParamsFormAttrs      = []
-    , dbParamsFormAddSubmit  = False
+    , dbParamsFormSubmit     = FormSubmit
     , dbParamsFormAdditional = \_ -> return (pure (), mempty)
     , dbParamsFormEvaluate   = liftHandlerT . runFormPost
     , dbParamsFormResult     = lens (\_ -> pure ()) (\s _ -> s)
     , dbParamsFormIdent      = def
     }
 
-dbParamsFormWrap :: Monoid x => DBParams (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) x -> (Html -> MForm (HandlerT UniWorX IO) (x, Widget)) -> (Html -> MForm (HandlerT UniWorX IO) (x, Widget))
+dbParamsFormWrap :: Monoid x => DBTable (MForm (HandlerT UniWorX IO)) x -> DBParams (MForm (HandlerT UniWorX IO)) x -> (Html -> MForm (HandlerT UniWorX IO) (x, Widget)) -> (Html -> MForm (HandlerT UniWorX IO) (x, Widget))
-dbParamsFormWrap DBParamsForm{..} tableForm frag = do
+dbParamsFormWrap DBTable{ dbtIdent } DBParamsForm{..} tableForm frag = do
   let form = mappend <$> tableForm frag <*> (fmap (over _1 $ (flip $ set dbParamsFormResult) mempty) $ dbParamsFormAdditional mempty)
   ((res, fWidget), enctype) <- listen form
-  return . (res,) $ do
+  return . (res,) $ wrapForm fWidget FormSettings
-    btnId <- newIdent
+    { formMethod   = dbParamsFormMethod
-    act <- traverse toTextUrl dbParamsFormAction
+    , formAction   = dbParamsFormAction
-    let submitField :: Field Handler ButtonSubmit
+    , formEncoding = enctype
-        submitField = buttonField BtnSubmit
+    , formAttrs    = dbParamsFormAttrs
-        submitView :: Widget
+    , formSubmit   = dbParamsFormSubmit
-        submitView = fieldView submitField btnId "" mempty (Right BtnSubmit) False
+    , formAnchor   = Just $ WithIdent dbtIdent ("form" :: Text)
-        enctype' = bool id (mappend $ fieldEnctype submitField) dbParamsFormAddSubmit enctype
+    }
-    $(widgetFile "table/form-wrap")
 
-data WithIdent x = forall ident. PathPiece ident => WithIdent { _ident :: ident, _withoutIdent :: x }
-
-instance PathPiece x => PathPiece (WithIdent x) where
-  toPathPiece (WithIdent ident x)
-    | not . null $ toPathPiece ident = toPathPiece ident <> "-" <> toPathPiece x
-    | otherwise = toPathPiece x
-  fromPathPiece txt = do
-    let sep = "-"
-    (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt
-    WithIdent <$> pure ident <*> fromPathPiece rest
 
 addPIHiddenField :: DBTable m' x -> PaginationInput -> (Html -> MForm m a) -> (Html -> MForm m a)
 addPIHiddenField DBTable{ dbtIdent } pi form fragment
@@ -683,10 +692,11 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
   (currentKeys, rows) <- fmap unzip . mapMaybeM dbtProj . map (\(dbrIndex, (E.Value dbrCount, dbrKey, dbrOutput)) -> (dbrKey, DBRow{..})) . zip [firstRow..] $ reproduceSorting rows'
 
+  Just currentRoute <- getCurrentRoute -- `dbTable` should never be called from a 404-handler
   getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
   let
-    tblLink :: (QueryText -> QueryText) -> Text
+    tblLink :: (QueryText -> QueryText) -> SomeRoute UniWorX
-    tblLink f = decodeUtf8 . toStrict . Builder.toLazyByteString . renderQueryText True $ (f . substPi . setParam "_hasdata" Nothing) getParams
+    tblLink f = SomeRoute . (currentRoute, ) . over (mapped . _2) (fromMaybe Text.empty) $ (f . substPi . setParam "_hasdata" Nothing) getParams
     substPi = foldr (.) id
       [ setParams (wIdent "sorting") . map toPathPiece $ fromMaybe [] piSorting
       , foldr (.) id . map (\k -> setParams (wIdent $ toPathPiece k) . fromMaybe [] . join $ traverse (Map.lookup k) piFilter) $ Map.keys dbtFilter
@@ -694,6 +704,8 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       , setParam (wIdent "page") $ fmap toPathPiece piPage
       , setParam (wIdent "pagination") Nothing
       ]
+    tblLink' :: (QueryText -> QueryText) -> Widget
+    tblLink' = toWidget <=< toTextUrl . tblLink
 
   let
     rowCount
@@ -706,7 +718,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       . setParam (wIdent "page") Nothing
       . setParam (wIdent "pagination") Nothing
 
-    table' :: WriterT x m Widget
+    table' :: HandlerSite m ~ UniWorX => WriterT x m Widget
     table' = do
       let
         genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do
@@ -737,7 +749,15 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       = 1
     pageNumbers = [0..pred pageCount]
 
-    uiLayout table = dbsFilterLayout filterWdgt filterEnc rawAction $(widgetFile "table/layout")
+    pagesizeWdgt' = wrapForm pagesizeWdgt FormSettings
+      { formMethod = GET
+      , formAction = Just . SomeRoute $ rawAction :#: wIdent "table-wrapper"
+      , formEncoding = pagesizeEnc
+      , formAttrs = [("class", "pagesize")]
+      , formSubmit = FormNoSubmit
+      , formAnchor = Just $ wIdent "pagesize-form"
+      }
+    uiLayout table = dbsFilterLayout filterWdgt filterEnc (SomeRoute $ rawAction :#: wIdent "table-wrapper") $(widgetFile "table/layout")
 
     dbInvalidateResult' = foldr (<=<) return . catMaybes $
       [ do

src/Utils.hs

@@ -22,6 +22,7 @@ import Utils.DB as Utils
 import Utils.TH as Utils
 import Utils.DateTime as Utils
 import Utils.PathPiece as Utils
+import Utils.Route as Utils
 import Utils.Message as Utils
 import Utils.Lang as Utils
 import Utils.Parameters as Utils
@@ -68,6 +69,8 @@ import qualified Crypto.Data.PKCS7 as PKCS7
 import Data.Fixed (Centi)
 import Data.Ratio ((%))
 
+{-# ANN choice ("HLint: ignore Use asum" :: String) #-}
+
 
 
 -----------
@@ -105,25 +108,6 @@ unsupportedAuthPredicate = do
     |]
 
 
-class RedirectUrl site url => HasRoute site url where
-  urlRoute :: url -> Route site
-
-instance HasRoute site (Route site) where
-  urlRoute = id
-instance (key ~ Text, val ~ Text) => HasRoute site (Route site, Map key val) where
-  urlRoute = view _1
-instance (key ~ Text, val ~ Text) => HasRoute site (Route site, [(key, val)]) where
-  urlRoute = view _1
-instance (HasRoute site a, PathPiece b) => HasRoute site (Fragment a b) where
-  urlRoute (a :#: _) = urlRoute a
-
-data SomeRoute site = forall url. HasRoute site url => SomeRoute url
-
-instance RedirectUrl site (SomeRoute site) where
-  toTextUrl (SomeRoute url) = toTextUrl url
-instance HasRoute site (SomeRoute site) where
-  urlRoute (SomeRoute url) = urlRoute url
-
 
 -- | A @Widget@ for any site; no language interpolation, etc.
 type WidgetSiteless = forall site. forall m. (MonadIO m, MonadThrow m, MonadBaseControl IO m)

src/Utils/Form.hs

@@ -33,52 +33,11 @@ import Data.UUID
 
 import Utils.Message
 import Utils.PathPiece
+import Utils.Route
 
 import Data.Proxy
 
--------------------
--- Form Renderer --
--------------------
 
--- | Use this type to pass information to the form template
-data FormLayout = FormStandard | FormDBTableFilter | FormDBTablePagesize
-
-renderAForm :: Monad m => FormLayout -> FormRender m a
-renderAForm formLayout aform fragment = do
-  (res, ($ []) -> fieldViews) <- aFormToForm aform
-  let widget = $(widgetFile "widgets/form/form")
-  return (res, widget)
-
--- | special id to identify form section headers, see 'aformSection' and 'formSection'
---   currently only treated by form generation through 'renderAForm'
-idFormSectionNoinput :: Text
-idFormSectionNoinput = "form-section-noinput"
-
--- | Generates a form having just a form-section-header and no input title.
---   Currently only correctly rendered by 'renderAForm' and mforms using 'widget/form.hamlet'
---   Usage:
---   @
---      (,) <$  formSection MsgInt
---          <*> areq intField "int here" Nothing
---          <*  formSection MsgDouble
---          <*> areq doubleField "double there " Nothing
---          <*  submitButton
---   @
---   If tooltips or other attributes are required, see 'formSection\'' instead.
-aformSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> AForm m ()
-aformSection = formToAForm . fmap (second pure) . formSection
-
-formSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
-formSection formSectionTitle = do
-    mr <- getMessageRender
-    return (FormSuccess (), FieldView
-      { fvLabel    = toHtml $ mr formSectionTitle
-      , fvTooltip  = Nothing
-      , fvId       = idFormSectionNoinput
-      , fvErrors   = Nothing
-      , fvRequired = False
-      , fvInput    = mempty
-      })
 
 
 --------------------
@@ -217,6 +176,7 @@ data FormIdentifier
   | FIDDBTable
   | FIDDelete
   | FIDCourseRegister
+  | FIDAdminDemo
   deriving (Eq, Ord, Read, Show)
 
 instance PathPiece FormIdentifier where
@@ -455,6 +415,90 @@ optionsFinite = do
       }
   return . mkOptionList $ mkOption <$> universeF
 
+
+-----------
+-- Forms --
+-----------
+
+data FormSubmitType = FormNoSubmit | FormSubmit | FormDualSubmit | FormAutoSubmit
+    deriving (Eq, Ord, Enum, Bounded, Read, Show, Typeable, Generic)
+
+instance Universe FormSubmitType
+instance Finite FormSubmitType
+
+data FormSettings site = forall p. PathPiece p => FormSettings
+      { formMethod     :: StdMethod
+      , formAction     :: Maybe (SomeRoute site)
+      , formEncoding   :: Enctype
+      , formAttrs      :: [(Text, Text)]
+      , formSubmit     :: FormSubmitType
+      , formAnchor     :: Maybe p
+      } deriving (Typeable)
+
+instance Default (FormSettings site) where
+  def = FormSettings
+    { formMethod   = POST
+    , formAction   = Nothing
+    , formEncoding = UrlEncoded
+    , formAttrs    = []
+    , formSubmit   = FormSubmit
+    , formAnchor   = Nothing :: Maybe Text
+    }
+
+wrapForm :: (Button site ButtonSubmit) => WidgetT site IO () -> FormSettings site -> WidgetT site IO ()
+wrapForm formWidget FormSettings{..} = do
+  formId <- maybe newIdent (return . toPathPiece) formAnchor
+  formActionUrl <- traverse toTextUrl formAction
+  $(widgetFile "widgets/form/form")
+
+
+-------------------
+-- Form Renderer --
+-------------------
+
+-- | Use this type to pass information to the form template
+data FormLayout = FormStandard | FormDBTableFilter | FormDBTablePagesize
+
+renderAForm :: Monad m => FormLayout -> FormRender m a
+renderAForm formLayout aform fragment = do
+  (res, ($ []) -> fieldViews) <- aFormToForm aform
+  let widget = $(widgetFile "widgets/aform/aform")
+  return (res, widget)
+
+
+-- | special id to identify form section headers, see 'aformSection' and 'formSection'
+--   currently only treated by form generation through 'renderAForm'
+idFormSectionNoinput :: Text
+idFormSectionNoinput = "form-section-noinput"
+
+-- | Generates a form having just a form-section-header and no input title.
+--   Currently only correctly rendered by 'renderAForm' and mforms using 'widget/form.hamlet'
+--   Usage:
+--   @
+--      (,) <$  formSection MsgInt
+--          <*> areq intField "int here" Nothing
+--          <*  formSection MsgDouble
+--          <*> areq doubleField "double there " Nothing
+--          <*  submitButton
+--   @
+--   If tooltips or other attributes are required, see 'formSection\'' instead.
+aformSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> AForm m ()
+aformSection = formToAForm . fmap (second pure) . formSection
+
+formSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
+formSection formSectionTitle = do
+    mr <- getMessageRender
+    return (FormSuccess (), FieldView
+      { fvLabel    = toHtml $ mr formSectionTitle
+      , fvTooltip  = Nothing
+      , fvId       = idFormSectionNoinput
+      , fvErrors   = Nothing
+      , fvRequired = False
+      , fvInput    = mempty
+      })
+
+
+
 -------------------
 -- Special Forms --
 -------------------

src/Utils/Route.hs

@@ -0,0 +1,28 @@
+module Utils.Route where
+
+import Control.Lens
+import ClassyPrelude.Yesod -- hiding (foldlM)
+
+
+class RedirectUrl site url => HasRoute site url where
+  urlRoute :: url -> Route site
+
+instance HasRoute site (Route site) where
+  urlRoute = id
+-- | for GET-Parameters
+instance (key ~ Text) => HasRoute site (Route site, Map key Text) where
+  urlRoute = view _1
+-- | for GET-Parameters
+instance (key ~ Text) => HasRoute site (Route site, [(key, Text)]) where
+  urlRoute = view _1
+-- | for PageAnchors, implemented through Fragments
+instance (HasRoute site a, PathPiece b) => HasRoute site (Fragment a b) where
+  urlRoute (a :#: _) = urlRoute a
+
+data SomeRoute site = forall url. HasRoute site url => SomeRoute url
+  deriving (Typeable)
+
+instance RedirectUrl site (SomeRoute site) where
+  toTextUrl (SomeRoute url) = toTextUrl url
+instance HasRoute site (SomeRoute site) where
+  urlRoute (SomeRoute url) = urlRoute url

static/js/utils/asyncTableFilter.js

@@ -34,7 +34,7 @@
     options = options || {};
     var tableIdent = options.dbtIdent;
 
-    var formId = formElement.querySelector('[name="_formid"]').value;
+    var formId = formElement.querySelector('[name="form-identifier"]').value;
     var inputs = {
       search: [],
       input: [],
@@ -127,7 +127,7 @@
 
     function serializeFormToURL() {
       var url = new URL(options.currentUrl || window.location.href);
-      url.searchParams.set('_formid', formId);
+      url.searchParams.set('form-identifier', formId);
       url.searchParams.set('_hasdata', 'true');
       url.searchParams.set(tableIdent + '-page', '0');
 

templates/adminFeatures.hamlet

@@ -12,8 +12,7 @@
         <ul>
           $forall (Entity _ (StudyTerms ky _ nm)) <- infConflicts
             <li> #{show ky} - #{foldMap id nm}
-    <form .form-inline method=post action=@{AdminFeaturesR} enctype=#{btnEnctype}>
+    ^{btnForm}
-      ^{btnWdgt}
 
     <div .container>
       ^{candidateTable}

templates/adminTest.hamlet

@@ -28,8 +28,7 @@
   <ul>
     <li>
       Knopf-Test:
-        <form .form-inline method=post action=@{AdminTestR} enctype=#{btnEnctype}>
+        ^{btnForm}
-          ^{btnWdgt}
     <li><br>
       Modals:
       ^{modal "Klick mich für Ajax-Test" (Left $ SomeRoute UsersR)}

templates/adminUser.hamlet

@@ -1,6 +1,4 @@
 <p>
   $# Does not use link-email.hamlet, but should
   ^{mailtoHtml userEmail}
-<form method=post action=@{AdminUserR uuid} enctype=#{formEnctype}>
+^{form}
-  ^{formWidget}
-  ^{submitButtonView}

templates/authpreds.hamlet

@@ -1,5 +1,2 @@
 _{MsgAuthPredsInfo}
-<form method=post action=@{AuthPredsR} enctype=#{authActiveEnctype}>
+^{authActiveForm}
-  $maybe referer <- mReferer
-    <input type=hidden name=#{toPathPiece GetReferer} value=#{toPathPiece referer}>
-  ^{authActiveWidget}

templates/correction.hamlet

@@ -7,9 +7,7 @@ $maybe marktxt <- sheetMarkingText
     <p>
       #{marktxt}
 <section>
-  <form method=post enctype=#{corrEncoding} action=@{CSubmissionR tid ssh csh shn cid CorrectionR}>
+  ^{corrForm}
-    ^{corrForm}
 
 <section>
-  <form method=post enctype=#{uploadEncoding} action=@{CSubmissionR tid ssh csh shn cid CorrectionR}>
+  ^{uploadForm}
-    ^{uploadForm}

templates/corrections-create.hamlet

@@ -1,2 +1 @@
-<form method=post action=@{CorrectionsCreateR} enctype=#{pseudonymEncoding}>
+^{pseudonymForm}
-  ^{pseudonymWidget}

templates/corrections-upload.hamlet

@@ -1,2 +1 @@
-<form method=POST enctype=#{uploadEncoding} action=@{CorrectionsUploadR}>
+^{uploadForm}
-  ^{upload}

templates/course.hamlet

@@ -50,9 +50,8 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
       <dd .deflist__dd>
         <div .course__registration>
           $if registrationOpen
-            <form method=post action=@{CourseR tid ssh csh CRegisterR} enctype=#{regEnctype}>
+            $# regForm is defined through templates/widgets/registerForm
-              $# regWidget is defined through templates/widgets/registerForm
+            ^{regForm}
-              ^{regWidget}
           $maybe date <- mRegAt
             _{MsgRegisteredSince date}
     <dt .deflist__dt>

templates/editTerm.hamlet

@@ -1,17 +0,0 @@
-<div .container>
-    <div .bs-docs-section>
-        <div .row>
-            <div .col-lg-12>
-                <div .page-header>
-                    <h1 #forms>Semester editieren/anlegen:
-
-        <div .row>
-            <div .col-lg-6>
-                <div .bs-callout bs-callout-info well>
-                    <form .form-horizontal method=post action=@{EditTermR}#forms enctype=#{formEnctype}>
-                        ^{formWidget}
-
-                        <button .btn.btn-primary type="submit">
-                            Semester anlegen
-
-

templates/formPage.hamlet

@@ -1,5 +0,0 @@
-$newline never
-$#TODO: anchor must be generic for working with multiple forms
-<a id="forms">
-<form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
-  ^{formWidget}

templates/formPageI18n.hamlet

@@ -1,8 +0,0 @@
-$newline never
-$maybe text <- formText
-  <h2>
-    _{text}
-$#TODO: anchor must be generic for working with multiple forms
-<a id="forms">
-<form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
-  ^{formWidget}

templates/formPageI18n.julius

@@ -1,21 +0,0 @@
-document.addEventListener('DOMContentLoaded', function () {
-
-  var themeSelector = document.querySelector('#theme-select');
-
-  if (themeSelector) {
-    themeSelector.addEventListener('change', function() {
-      // get rid of old themes on body
-      var options = Array.from(themeSelector.options)
-      .forEach(function (option) {
-        document.body.classList.remove(optionToTheme(option));
-      });
-      // add newly selected theme
-      document.body.classList.add(optionToTheme(themeSelector.selectedOptions[0]));
-    });
-  }
-
-  function optionToTheme(option) {
-    return optionValue = 'theme--' + option.value;
-  }
-
-});

templates/help.hamlet

@@ -1,3 +1,3 @@
-<form method=post action=@{HelpR} enctype=#{formEnctype} :isModal:data-ajax-submit>
+<p>
-   <div>_{MsgHelpIntroduction}
+  _{MsgHelpIntroduction}
-   ^{formWidget}
+^{form}

templates/newCourse.hamlet

@@ -1,20 +0,0 @@
-<div .container>
-    <div .bs-docs-section>
-        <div .row>
-            <div .col-lg-12>
-                <div .page-header>
-                    <h1 #forms>Neuen Kurs anlegen:
-
-                    <p>
-                        Bitte alles ausfüllen!
-
-        <div .row>
-            <div .col-lg-6>
-                <div .bs-callout bs-callout-info well>
-                    <form .form-horizontal method=post action=@{NewCourseR}#forms enctype=#{formEnctype}>
-                        ^{formWidget}
-
-                        <button .btn.btn-primary type="submit">
-                            Kurs anlegen
-
-

templates/sheetShow.hamlet

@@ -32,8 +32,7 @@ $maybe descr <- sheetDescription sheet
           $maybe pseudonym <- mPseudonym
             <span .pseudonym>#{pseudonym}
           $nothing
-            <form method=post action=@{CSheetR tid ssh csh shn SPseudonymR} enctype=#{generateEnctype}>
+            ^{generateForm}
-              ^{generateWidget}
       $of _
     <dt .deflist__dt>_{MsgSheetType}
     <dd .deflist__dd>_{sheetType sheet}

templates/submission-assign.hamlet

@@ -1,2 +1 @@
-<form method=post action=@{actionUrl} enctype=#{corrEncoding}>
+^{corrForm}
-   ^{corrForm}

templates/submission-list.hamlet

@@ -1,8 +0,0 @@
-<div .container>
-  <form method=POST enctype=#{uploadEnctype} action=@{SubmissionListR}>
-    ^{uploadWidget}
-
-<div .container>
-  <form method=POST enctype=#{selectEncoding} target=_blank action=@{SubmissionDownloadMultiArchiveR}>
-    ^{subTable}
-    <button .btn .btn-default type=submit >Markierte herunterladen

templates/submission.hamlet

@@ -25,5 +25,4 @@ $maybe cID <- mcid
 
 $if maySubmit
   <section>
-    <form .form-horizontal method=post action=@{actionUrl} enctype=#{formEnctype}>
+    ^{formWidget}
-      ^{formWidget}

templates/system-message-list.hamlet

@@ -2,5 +2,4 @@
   ^{tableView}
 
 <section>
-  <form method=post action=@{MessageListR} enctype=#{addEncoding}>
+  ^{addForm}
-    ^{addView}

templates/table/cell/header.hamlet

@@ -2,10 +2,10 @@
   $maybe flag <- sortableKey
     $case directions
       $of [SortAsc]
-        <a .table__th-link href=#{tblLink $ setParam (wIdent "sorting") (Just $ toPathPiece (SortingSetting flag SortDesc))}>
+        <a .table__th-link href=^{tblLink' $ setParam (wIdent "sorting") (Just $ toPathPiece (SortingSetting flag SortDesc))}>
           ^{widget}
       $of _
-        <a .table__th-link href=#{tblLink $ setParam (wIdent "sorting") (Just $ toPathPiece (SortingSetting flag SortAsc))}>
+        <a .table__th-link href=^{tblLink' $ setParam (wIdent "sorting") (Just $ toPathPiece (SortingSetting flag SortAsc))}>
           ^{widget}
   $nothing
     ^{widget}

templates/table/form-wrap.hamlet

@@ -1,5 +0,0 @@
-$newline never
-<form method=#{decodeUtf8 (renderStdMethod dbParamsFormMethod)} action=#{fromMaybe "" act} *{dbParamsFormAttrs} enctype=#{enctype'}>
-  ^{fWidget}
-  $if dbParamsFormAddSubmit
-    ^{submitView}

templates/table/layout-filter-default.hamlet

@@ -2,8 +2,5 @@ $newline never
 <div .table-filter>
   <h3 .js-show-hide__toggle data-sh-index=table-filter data-collapsed=true>Filter
   <div>
-    <form .table-filter-form method=GET action=#{filterAction} enctype=#{filterEnctype}>
+    ^{filterForm}
-      ^{filterWgdt}
-      <button type=submit data-autosubmit>
-        ^{btnLabel BtnSubmit}
 ^{scrolltable}

templates/table/layout.hamlet

@@ -9,13 +9,12 @@ $else
       _{MsgRowCount rowCount}
     $# Since the current pagesize is always a member of pagesizeOptions we don't need to check `pageCount > 1`
     $if toEnum (fromIntegral rowCount) > minimum (pagesizeOptions referencePagesize)
-      <form .pagesize ##{wIdent "pagesize-form"} method=GET enctype=#{pagesizeEnc} action=#{rawAction}>
+      ^{pagesizeWdgt'}
-        ^{pagesizeWdgt}
 
   $if pageCount > 1
     <div .pagination>
       <ul ##{wIdent "pagination"} .pages>
         $forall p <- pageNumbers
           <li .page-link :p == psPage:.current>
-            <a href=#{tblLink $ setParam (wIdent "page") (Just $ tshow p)}>
+            <a href=^{tblLink' $ setParam (wIdent "page") (Just $ tshow p)}>
               _{MsgPage (succ p)}

templates/widgets/aform/aform.hamlet

@@ -0,0 +1,23 @@
+$newline never
+#{fragment}
+$case formLayout
+  $of FormDBTablePagesize
+    $forall view <- fieldViews
+      <label .form-group__label.label-pagesize for=#{fvId view}>#{fvLabel view}
+      ^{fvInput view}
+  $of _
+    $forall view <- fieldViews
+      $if fvId view == idFormSectionNoinput
+        <h3 .form-section-title>
+          ^{fvLabel view}
+      $else
+        <div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
+          $if not (Blaze.null $ fvLabel view)
+            <label .form-group__label for=#{fvId view}>
+              #{fvLabel view}
+              $maybe hint <- fvTooltip view
+                <div .form-group__hint>^{hint}
+          <div .form-group__input>
+            ^{fvInput view}
+            $maybe err <- fvErrors view
+              <div .form-error>#{err}

templates/widgets/campus-login/campus-login-form.hamlet

@@ -1,2 +1 @@
-<form method=POST action=@{toMaster $ PluginR "LDAP" []} enctype=#{loginEnctype} #login--campus>
+^{loginForm}
-  ^{login}

templates/widgets/data-delete/data-delete.hamlet

@@ -1,27 +1,26 @@
-<form .form-inline method=post action=@{ProfileDataR} enctype=#{btnEnctype}>
+<h2>
-  <h2>
+  Sind Sie sich absolut sicher, alle Ihre in Uni2work gespeicherten Daten zu löschen?
-    Sind Sie sich absolut sicher, alle Ihre in Uni2work gespeicherten Daten zu löschen?
+<p>
-  <div .container>
+    Während der Testphase von Uni2work können Sie hiermit
-      Während der Testphase von Uni2work können Sie hiermit
+    Ihren Account bei Uni2work vollständig löschen.
-      Ihren Account bei Uni2work vollständig löschen.
+    Mit Ihrem Campus-Account können Sie sich aber danach
-      Mit Ihrem Campus-Account können Sie sich aber danach
+    jederzeit erneut einloggen, wodurch wieder ein leerer Account erstellt wird.
-      jederzeit erneut einloggen, wodurch wieder ein leerer Account erstellt wird.
+<p>
-  <div .container>
+    Hochgeladene Hausaufgaben-Dateien werden unabhhängig vom Urherber nur dann gelöscht,
-      Hochgeladene Hausaufgaben-Dateien werden unabhhängig vom Urherber nur dann gelöscht,
+    wenn die Dateien ausschließlich Ihnen zugeordnet sind.
-      wenn die Dateien ausschließlich Ihnen zugeordnet sind.
+    Dateien aus Gruppenabgaben werden also erst dann gelöscht,
-      Dateien aus Gruppenabgaben werden also erst dann gelöscht,
+    wenn alle Gruppenmitglieder Ihren Account gelöscht haben.
-      wenn alle Gruppenmitglieder Ihren Account gelöscht haben.
+<p>
-  <div .container>
+    <em>Achtung:
-      <em>Achtung:
+    Auch abgegebene Hausübungen werden gelöscht!
-      Auch abgegebene Hausübungen werden gelöscht!
+    Falls ein Veranstalter Informationen darüber nicht anderweitig gespeichert hat,
-      Falls ein Veranstalter Informationen darüber nicht anderweitig gespeichert hat,
+    kann dadurch ein etwaiger Hausaufgabenbonus verloren gehen.
-      kann dadurch ein etwaiger Hausaufgabenbonus verloren gehen.
+    (Verbuchte Noten sollten dadurch nicht betroffen sein, aber in einem etwaigen
-      (Verbuchte Noten sollten dadurch nicht betroffen sein, aber in einem etwaigen
+    Streitfall konnen die per Uni2work verwalteten Hausaufgaben dann
-      Streitfall konnen die per Uni2work verwalteten Hausaufgaben dann
+    auch nicht mehr rekonstruiert/berücksichtigt werden.)
-      auch nicht mehr rekonstruiert/berücksichtigt werden.)
+<p>
-  <div .container>
+  <em>Nach der Testphase von Uni2work wird das Löschen eines Accounts etwas
-    <em>Nach der Testphase von Uni2work wird das Löschen eines Accounts etwas
+  eingeschränkt werden, da z.B. Klausurnoten 5 Jahre bis nach Exmatrikulation
-    eingeschränkt werden, da z.B. Klausurnoten 5 Jahre bis nach Exmatrikulation
+  aufbewahrt werden müssen.
-    aufbewahrt werden müssen.
+
-  <div .container>
+^{btnForm}
-    ^{btnWdgt}

templates/widgets/delete-confirmation/delete-confirmation.hamlet

@@ -9,5 +9,4 @@
 <p .confirmationText>
   #{confirmString}
 
-<form method=POST action=@{targetRoute} enctype=#{deleteFormEnctype}>
+^{deleteForm}
-  ^{deleteFormWdgt}

templates/widgets/dummy-login-form/dummy-login-form.hamlet

@@ -1,2 +1 @@
-<form method=POST action=@{toMaster $ PluginR "dummy" []} enctype=#{loginEnctype} #login--dummy>
+^{loginForm}
-  ^{login}

templates/widgets/form/form.hamlet

@@ -1,23 +1,17 @@
 $newline never
-#{fragment}
+$# Wrapper for all kinds of forms
-$case formLayout
+<form ##{formId} method=#{decodeUtf8 (renderStdMethod formMethod)} action=#{fromMaybe "" formActionUrl} enctype=#{formEncoding} *{formAttrs}>
-  $of FormDBTablePagesize
+  $# Distinguish different falvours of submit button layouts here:
-    $forall view <- fieldViews
+  $case formSubmit
-      <label .form-group__label.label-pagesize for=#{fvId view}>#{fvLabel view}
+    $of FormNoSubmit
-      ^{fvInput view}
+      ^{formWidget}
-  $of _
+    $of FormSubmit
-    $forall view <- fieldViews
+      ^{formWidget}
-      $if fvId view == idFormSectionNoinput
+      ^{submitButtonView}
-        <h3 .form-section-title>
+    $of FormDualSubmit
-          ^{fvLabel view}
+      ^{submitButtonView}
-      $else
+      ^{formWidget}
-        <div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
+      ^{submitButtonView}
-          $if not (Blaze.null $ fvLabel view)
+    $of FormAutoSubmit
-            <label .form-group__label for=#{fvId view}>
+      <button type=submit data-autosubmit>
-              #{fvLabel view}
+        ^{btnLabel BtnSubmit}
-              $maybe hint <- fvTooltip view
-                <div .form-group__hint>^{hint}
-          <div .form-group__input>
-            ^{fvInput view}
-            $maybe err <- fvErrors view
-              <div .form-error>#{err}

templates/widgets/form/form.julius

@@ -1,5 +1,3 @@
 document.addEventListener('DOMContentLoaded', function() {
-  Array.from(document.querySelectorAll('form')).forEach(function(form) {
+  window.utils.setup('form', document.querySelector('#' + #{String formId}));
-    window.utils.setup('form', form);
-  });
 });

templates/widgets/hash-login-form/hash-login-form.hamlet

@@ -1,2 +1 @@
-<form method=POST action=@{toMaster $ PluginR "PWHash" []} enctype=#{loginEnctype} #login--hash>
+^{loginForm}
-  ^{login}