Use wrapForm everywhere

This commit is contained in:
Gregor Kleen 2019-03-23 23:00:32 +01:00
parent 6aeb134369
commit 57ba1c9e12
47 changed files with 323 additions and 293 deletions

View File

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

View File

@ -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

View File

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

View File

@ -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|
<form method=post action=@{AdminTestR} enctype=#{emailEnctype} data-ajax-submit>
^{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|<h2>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|
<h2>Mass-Input
<form enctype=#{miEnc} method=POST>
^{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
<pre style="white-space:pre-wrap; font-family:monospace">
#{encodePrettyToTextBuilder t}
<form action=@{AdminErrMsgR} method=post enctype=#{ctEncoding}>
^{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{..}

View File

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

View File

@ -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

View File

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

View File

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

View File

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

View File

@ -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

View File

@ -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,22 +89,37 @@ postMessageR cID = do
redirect $ MessageR cID
let
messageEditModal = modal [whamlet|_{MsgSystemMessageEdit}|] $ Right
[whamlet|
<form method=post action=@{MessageR cID} enctype=#{modifyEnctype}>
^{modifyView}
|]
translationAddModal = modal [whamlet|_{MsgSystemMessageAddTranslation}|] $ Right
[whamlet|
<form method=post action=@{MessageR cID} enctype=#{addTransEnctype}>
^{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
| 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), transEnctype) <- modifyTranss'
$forall transView <- modifyTranss''
<section>
<form method=post action=@{MessageR cID} enctype=#{transEnctype}>
^{transView}
|]
| otherwise = mempty
@ -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")

View File

@ -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

View File

@ -71,10 +71,14 @@ getUsersR = do
myUid <- liftHandlerT maybeAuthId
when (mayHijack && Just uid /= myUid) $ do
(hijackView, hijackEnctype) <- liftHandlerT . generateFormPost $ hijackUserForm cID
[whamlet|
<form method=POST action=@{AdminHijackUserR cID} enctype=#{hijackEnctype}>
^{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}|]

View File

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

View File

@ -116,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)

View File

@ -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 DBParamsForm{..} tableForm frag = do
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 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
btnId <- newIdent
act <- traverse toTextUrl dbParamsFormAction
let submitField :: Field Handler ButtonSubmit
submitField = buttonField BtnSubmit
submitView :: Widget
submitView = fieldView submitField btnId "" mempty (Right BtnSubmit) False
enctype' = bool id (mappend $ fieldEnctype submitField) dbParamsFormAddSubmit enctype
$(widgetFile "table/form-wrap")
return . (res,) $ wrapForm fWidget FormSettings
{ formMethod = dbParamsFormMethod
, formAction = dbParamsFormAction
, formEncoding = enctype
, formAttrs = dbParamsFormAttrs
, formSubmit = dbParamsFormSubmit
, formAnchor = Just $ WithIdent dbtIdent ("form" :: Text)
}
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 f = decodeUtf8 . toStrict . Builder.toLazyByteString . renderQueryText True $ (f . substPi . setParam "_hasdata" Nothing) getParams
tblLink :: (QueryText -> QueryText) -> SomeRoute UniWorX
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

View File

@ -176,6 +176,7 @@ data FormIdentifier
| FIDDBTable
| FIDDelete
| FIDCourseRegister
| FIDAdminDemo
deriving (Eq, Ord, Read, Show)
instance PathPiece FormIdentifier where
@ -419,27 +420,29 @@ optionsFinite = do
-- Forms --
-----------
data FormSubmitType = FormNoSubmit | FormSubmit | FormDualSubmit
data FormSubmitType = FormNoSubmit | FormSubmit | FormDualSubmit | FormAutoSubmit
deriving (Eq, Ord, Enum, Bounded, Read, Show, Typeable, Generic)
instance Universe FormSubmitType
instance Finite FormSubmitType
data FormSettings site = FormSettings
{ formMethod :: Method
data FormSettings site = forall p. PathPiece p => FormSettings
{ formMethod :: StdMethod
, formAction :: Maybe (SomeRoute site)
, formEncoding :: Enctype
, formAttrs :: [(Text, Text)]
, formSubmit :: FormSubmitType
, formAnchor :: Maybe FormIdentifier
} deriving (Generic, Typeable)
, formAnchor :: Maybe p
} deriving (Typeable)
instance Default (FormSettings site) where
def = FormSettings
{ formMethod = methodPost
{ formMethod = POST
, formAction = Nothing
, formEncoding = UrlEncoded
, formAttrs = []
, formSubmit = FormSubmit
, formAnchor = Nothing
, formAnchor = Nothing :: Maybe Text
}
wrapForm :: (Button site ButtonSubmit) => WidgetT site IO () -> FormSettings site -> WidgetT site IO ()

View File

@ -10,16 +10,17 @@ class RedirectUrl site url => HasRoute site url where
instance HasRoute site (Route site) where
urlRoute = id
-- | for GET-Parameters
instance (key ~ Text, val ~ Text) => HasRoute site (Route site, Map key val) where
instance (key ~ Text) => HasRoute site (Route site, Map key Text) where
urlRoute = view _1
-- | for GET-Parameters
instance (key ~ Text, val ~ Text) => HasRoute site (Route site, [(key, val)]) where
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

View File

@ -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}>
^{btnWdgt}
^{btnForm}
<div .container>
^{candidateTable}

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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}>
$# regWidget is defined through templates/widgets/registerForm
^{regWidget}
$# regForm is defined through templates/widgets/registerForm
^{regForm}
$maybe date <- mRegAt
_{MsgRegisteredSince date}
<dt .deflist__dt>

View File

@ -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

View File

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

View File

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

View File

@ -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;
}
});

View File

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

View File

@ -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

View File

@ -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}>
^{generateWidget}
^{generateForm}
$of _
<dt .deflist__dt>_{MsgSheetType}
<dd .deflist__dd>_{sheetType sheet}

View File

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

View File

@ -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

View File

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

View File

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

View File

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

View File

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

View File

@ -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}>
^{filterWgdt}
<button type=submit data-autosubmit>
^{btnLabel BtnSubmit}
^{filterForm}
^{scrolltable}

View File

@ -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)}

View File

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

View File

@ -1,17 +1,16 @@
<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?
<div .container>
<p>
Während der Testphase von Uni2work können Sie hiermit
Ihren Account bei Uni2work vollständig löschen.
Mit Ihrem Campus-Account können Sie sich aber danach
jederzeit erneut einloggen, wodurch wieder ein leerer Account erstellt wird.
<div .container>
<p>
Hochgeladene Hausaufgaben-Dateien werden unabhhängig vom Urherber nur dann gelöscht,
wenn die Dateien ausschließlich Ihnen zugeordnet sind.
Dateien aus Gruppenabgaben werden also erst dann gelöscht,
wenn alle Gruppenmitglieder Ihren Account gelöscht haben.
<div .container>
<p>
<em>Achtung:
Auch abgegebene Hausübungen werden gelöscht!
Falls ein Veranstalter Informationen darüber nicht anderweitig gespeichert hat,
@ -19,9 +18,9 @@
(Verbuchte Noten sollten dadurch nicht betroffen sein, aber in einem etwaigen
Streitfall konnen die per Uni2work verwalteten Hausaufgaben dann
auch nicht mehr rekonstruiert/berücksichtigt werden.)
<div .container>
<p>
<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
aufbewahrt werden müssen.
<div .container>
^{btnWdgt}
^{btnForm}

View File

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

View File

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

View File

@ -1,6 +1,6 @@
$newline never
$# Wrapper for all kinds of forms
<form ##{formId} method=#{decodeUtf8 formMethod} action=#{fromMaybe "" formActionUrl} enctype=#{formEncoding}>
<form ##{formId} method=#{decodeUtf8 (renderStdMethod formMethod)} action=#{fromMaybe "" formActionUrl} enctype=#{formEncoding} *{formAttrs}>
$# Distinguish different falvours of submit button layouts here:
$case formSubmit
$of FormNoSubmit
@ -12,3 +12,6 @@ $# Wrapper for all kinds of forms
^{submitButtonView}
^{formWidget}
^{submitButtonView}
$of FormAutoSubmit
<button type=submit data-autosubmit>
^{btnLabel BtnSubmit}

View File

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