diff --git a/frontend/src/utils/form/form-error-remover.js b/frontend/src/utils/form/form-error-remover.js index 6c86160b3..235dd8ade 100644 --- a/frontend/src/utils/form/form-error-remover.js +++ b/frontend/src/utils/form/form-error-remover.js @@ -3,44 +3,41 @@ import { Utility } from '../../core/utility'; const FORM_ERROR_REMOVER_INITIALIZED_CLASS = 'form-error-remover--initialized'; const FORM_ERROR_REMOVER_INPUTS_SELECTOR = 'input:not([type="hidden"]), textarea, select'; -const FORM_GROUP_SELECTOR = '.form-group'; -const FORM_GROUP_WITH_ERRORS_CLASS = 'form-group--has-error'; +const FORM_GROUP_WITH_ERRORS_CLASSES = ['form-group--has-error', 'standalone-field--has-error']; +const FORM_GROUP_SELECTOR = FORM_GROUP_WITH_ERRORS_CLASSES.map(c => '.' + c).join(', '); @Utility({ - selector: 'form', + selector: FORM_GROUP_SELECTOR, }) export class FormErrorRemover { + _element; + constructor(element) { - if (!element) { + if (!element) throw new Error('Form Error Remover utility needs to be passed an element!'); - } - if (element.classList.contains(FORM_ERROR_REMOVER_INITIALIZED_CLASS)) { - return false; - } + if (element.classList.contains(FORM_ERROR_REMOVER_INITIALIZED_CLASS)) + return; - // find form groups - const formGroups = Array.from(element.querySelectorAll(FORM_GROUP_SELECTOR)); + if (FORM_GROUP_WITH_ERRORS_CLASSES.every(c => !element.classList.contains(c))) + return; - formGroups.forEach((formGroup) => { - if (!formGroup.classList.contains(FORM_GROUP_WITH_ERRORS_CLASS)) { - return; - } + this._element = element; + + this._element.classList.add(FORM_ERROR_REMOVER_INITIALIZED_CLASS); + } - const inputElements = Array.from(formGroup.querySelectorAll(FORM_ERROR_REMOVER_INPUTS_SELECTOR)); - if (!inputElements) { - return false; - } + start() { + if (!this._element) + return; - inputElements.forEach((inputElement) => { - inputElement.addEventListener('input', () => { - formGroup.classList.remove(FORM_GROUP_WITH_ERRORS_CLASS); - }); + const inputElements = Array.from(this._element.querySelectorAll(FORM_ERROR_REMOVER_INPUTS_SELECTOR)); + + inputElements.forEach((inputElement) => { + inputElement.addEventListener('input', () => { + FORM_GROUP_WITH_ERRORS_CLASSES.forEach(c => { this._element.classList.remove(c); }); }); }); - - // mark initialized - element.classList.add(FORM_ERROR_REMOVER_INITIALIZED_CLASS); } } diff --git a/frontend/src/utils/inputs/inputs.sass b/frontend/src/utils/inputs/inputs.sass index f1eee6cad..6746e5094 100644 --- a/frontend/src/utils/inputs/inputs.sass +++ b/frontend/src/utils/inputs/inputs.sass @@ -78,10 +78,32 @@ font-weight: 600 color: var(--color-error) margin: 7px 0 + white-space: pre-wrap .form-error display: none +.standalone-field + display: inline-flex + + &__error + display: none + align-self: center + flex: 0 0 auto + + .tooltip__content + font-weight: 600 + color: var(--color-error) + white-space: pre-wrap + + &--has-error + input, textarea + border-color: var(--color-error) !important + + .standalone-field__error + display: block + + @media (max-width: 768px) .form-group grid-template-columns: 1fr diff --git a/messages/campus/de.msg b/messages/campus/de.msg index 43d544af9..1fc91d29c 100644 --- a/messages/campus/de.msg +++ b/messages/campus/de.msg @@ -1,6 +1,4 @@ CampusIdentPlaceholder: Vorname.Nachname@campus.lmu.de CampusIdent: Campus-Kennung CampusPassword: Passwort -CampusPasswordPlaceholder: Passwort -CampusSubmit: Abschicken -CampusInvalidCredentials: Ungültige Logindaten \ No newline at end of file +CampusPasswordPlaceholder: Passwort \ No newline at end of file diff --git a/messages/campus/en.msg b/messages/campus/en.msg index 6264db29e..989b444d4 100644 --- a/messages/campus/en.msg +++ b/messages/campus/en.msg @@ -1,6 +1,4 @@ CampusIdentPlaceholder: First.Last@campus.lmu.de CampusIdent: Campus account CampusPassword: Password -CampusPasswordPlaceholder: Password -CampusSubmit: Send -CampusInvalidCredentials: Invalid login +CampusPasswordPlaceholder: Password \ No newline at end of file diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index dd9febb1f..ddc5218a4 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -91,6 +91,7 @@ TermEndDay: Letzter Tag TermEndDayTooltip: Üblicherweise immer 30. September oder 31. März TermHolidays: Feiertage TermHolidayPlaceholder: Feiertag +TermHolidayMissing: Feiertag wird benötigt TermLectureStart: Beginn Vorlesungen TermLectureEnd: Ende Vorlesungen TermLectureEndTooltip: Meistens dauer das Sommersemester 14 Wochen und das Wintersemester 15 Wochen. @@ -257,6 +258,7 @@ CourseFormSectionRegistration: Anmeldung zum Kurs CourseFormSectionAdministration: Verwaltung CourseLecturers: Kursverwalter +CourseLecturerEmail: E-Mail CourseLecturer: Dozent CourseAssistant: Assistent CourseLecturerAlreadyAdded: Dieser Nutzer ist bereits als Kursverwalter eingetragen @@ -775,6 +777,8 @@ CampusUserInvalidSex: Konnte anhand des Campus-Logins kein Geschlecht ermitteln CorrectorNormal: Normal CorrectorMissing: Abwesend CorrectorExcused: Entschuldigt +SheetCorrectorState: Status +SheetCorrectorProportion: Anteil CorrectorStateTip: Abwesende Korrektoren bekommen bei späteren Übungsblättern mehr Korrekturen zum Ausgleich zugewiesen. Entschuldigte Korrektoren müssen nicht nacharbeiten. DayIsAHoliday tid@TermId name@Text date@Text: "#{name}" (#{date}) ist ein Feiertag @@ -843,6 +847,7 @@ NoStudyField: Kein Studienfach StudyFeatureType: StudyFeatureValid: Aktiv StudyFeatureUpdate: Abgeglichen +StudyTermsParentMissing: Elter wird benötigt DegreeKey: Abschlussschlüssel DegreeName: Abschluss @@ -1510,6 +1515,7 @@ SubmissionUserInviteExplanation: Sie wurden eingeladen, Mitabgebende(r) bei eine ExamOfficeUserInviteHeading displayName@Text: Zugriff auf Ihre Prüfungsleistungen durch #{displayName} ExamOfficeUserInviteExplanation: Um Ihre Prüfungsleistungen ordnungsgemäß anrechnen zu können (z.B. im finalen Transcript of Records für Erasmus-Studierende) werden sie eingeladen der hierfür zuständigen Stelle Einsicht zu gewähren. ExamOfficeUserInvitationAccepted: Einsicht erfolgreich gewährt +ExamOfficeUserEmail: E-Mail InvitationAction: Aktion InvitationActionTip: Abgelehnte Einladungen können nicht mehr angenommen werden @@ -1576,6 +1582,7 @@ TutorialRegGroupTip: Studenten können sich in jeweils maximal einem Tutorium pr TutorialRoomPlaceholder: Raum TutorialTutors: Tutoren TutorialTutorAlreadyAdded: Ein Tutor mit dieser E-Mail ist bereits für dieses Tutorium eingetragen +TutorEmail: E-Mail OccurrenceNoneScheduled: (Noch) keine planmäßigen Termine OccurrenceNoneExceptions: (Noch) keine Termin-Ausnahmen @@ -1701,6 +1708,7 @@ ExamNoSuchOccurrence: Termin/Raum existiert nicht (mehr) ExamOccurrences: Termine ExamRooms: Räume ExamTimes: Termine +ExamRoomRoom: Raum ExamRoomAlreadyExists: Prüfung ist bereits eingetragen ExamRoomName: Interne Bezeichnung ExamRoomCapacity: Kapazität @@ -1724,6 +1732,7 @@ ExamFormParts: Teile ExamCorrectors: Korrektoren ExamCorrectorsTip: Hier eingetragene Korrektoren können zwischen Beginn der Prüfung und "Bewertung abgeschlossen ab" Ergebnisse für alle Teilprüfungen und alle Teilnehmer im System hinterlegen. ExamCorrectorAlreadyAdded: Ein Korrektor mit dieser E-Mail ist bereits für diese Prüfung eingetragen +ExamCorrectorEmail: E-Mail ExamPart: Teilprüfung/Aufgabe ExamParts: Teilprüfungen/Aufgaben @@ -2109,6 +2118,7 @@ SchoolShort: Kürzel SchoolName: Name SchoolLdapOrganisations: Assoziierte LDAP-Fragmente SchoolLdapOrganisationsTip: Beim Login via LDAP werden dem Nutzer alle Institute zugeordnet deren assoziierte LDAP-Fragmente im Eintrag des Nutzer gefunden werden +SchoolLdapOrganisationMissing: LDAP-Fragment wird benötigt SchoolUpdated ssh@SchoolId: #{ssh} erfolgreich angepasst SchoolTitle ssh@SchoolId: Institut „#{ssh}“ @@ -2428,6 +2438,7 @@ ExternalExamExamOfficeSchoolsTip: Prüfungsbeauftragte von Instituten, die Sie h ExternalExamStaff: Assoziierte Personen ExternalExamStaffTip: Assoziierte Personen werden den Prüfungsbeauftragten und Teilnehmern angezeigt und dürfen Leistungen für die Prüfung hinterlegen. ExternalExamStaffAlreadyAdded: Person wurde bereits der Prüfung hinzugefügt +ExternalExamStaffEmail: E-Mail ExternalExamUserMustBeStaff: Sie selbst müssen stets assoziierte Person sein, für die externen Prüfungen, die Sie anlegen ExternalExamCourseExists: Der angegebene Kurs existiert im System. Prüfungen sollten daher direkt beim Kurs (statt extern) hinterlegt werden. ExternalExamExists coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ existiert bereits. @@ -2530,13 +2541,17 @@ CourseOption tid@TermId ssh@SchoolId coursen@CourseName: #{tid} - #{ssh} - #{cou BearerTokenUsageWarning: Mit diesem Interface können quesi beliebige Rechte als Tokens kodiert und somit ohne wesentliche weitere Beschränkung frei übertragen werden. Benutzen Sie dieses Interface nur, wenn Sie von einem erfahrenen Entwickler über die Auswirkungen des konkreten Tokens, dass sie ausstellen möchten, beraten wurden! BearerTokenAuthorityGroups: Token-Authorität (Gruppen) BearerTokenAuthorityGroupsTip: Die primären Benutzer aller angegebenen Gruppen müssen Zugriff auf eine Route haben, damit das Token den Zugriff auf diese Route erlaubt. +BearerTokenAuthorityGroupMissing: Gruppe wird benötigt BearerTokenAuthorityUsers: Token-Authorität (Benutzer) BearerTokenAuthorityUsersTip: Alle angegebenen Benutzer müssen Zugriff auf eine Route haben, damit das Token den Zugriff auf diese Route erlaubt. Der Aussteller muss, bei mit diesem Benutzerinterface erzeugten Tokens, auch Zugriff auf die Route haben (er wird automatisch der Menge von Token-Authoritäten hinzugefügt). BearerTokenAuthorityUnknownUser email@UserEmail: Ein Nutzer mit E-Mail #{email} ist dem System nicht bekannt BearerTokenRoutes: Erlaubte Routen BearerTokenRoutesTip: Wenn die Token-Validität nach Routen eingeschränkt und keine Routen angegeben werden, ist das Token nirgends gültig. +BearerTokenRouteMissing: Route wird benötigt BearerTokenRestrictions: Routen-spezifische Einschränkungen BearerTokenRestrictRoutes: Token-Validität nach Routen einschränken +BearerTokenRestrictRoute: Route +BearerTokenRestrictValue: Einschränkung BearerTokenAdditionalAuth: Zusätzliche Authorisierung BearerTokenAdditionalAuthTip: Wird hier nichts angegeben, werden keine Einschränkungen daran gesetzt, wer das Token verwenden kann. Es reicht dann der Besitz. BearerTokenOverrideExpiration: Ablaufzeitpunkt überschreiben @@ -2564,4 +2579,7 @@ TestDownloadMaxSize: Maximale Dateigröße TestDownloadMode: Modus TestDownloadDirect: Direkte Generierung TestDownloadInTransaction: Generierung während Datenbank-Transaktion -TestDownloadFromDatabase: Generierung während Download aus Datenbank \ No newline at end of file +TestDownloadFromDatabase: Generierung während Download aus Datenbank + +ValueRequiredLabeledSimple fieldLabel@Text: #{fieldLabel} wird benötigt +ValueRequiredLabeledMultiWord fieldLabel@Text: „#{fieldLabel}“ wird benötigt \ No newline at end of file diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 8001d2807..08aab78ce 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -2563,3 +2563,6 @@ TestDownloadMode: Mode TestDownloadDirect: Direct generation TestDownloadInTransaction: Generate during database transaction TestDownloadFromDatabase: Generate while streaming from database + +ValueRequiredLabeledSimple fieldLabel: #{fieldLabel} is required +ValueRequiredLabeledMultiWord fieldLabel: “#{fieldLabel}” is required \ No newline at end of file diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index 898349bf0..c433cae8a 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -18,14 +18,15 @@ data DummyMessage = MsgDummyIdent dummyForm :: ( RenderMessage (HandlerSite m) FormMessage + , RenderMessage (HandlerSite m) (ValueRequired (HandlerSite m)) , RenderMessage (HandlerSite m) DummyMessage , YesodPersist (HandlerSite m) , SqlBackendCanRead (YesodPersistBackend (HandlerSite m)) , MonadHandler m - ) => AForm m (CI Text) -dummyForm = wFormToAForm $ do + ) => WForm m (FormResult (CI Text)) +dummyForm = do mr <- getMessageRender - aFormToWForm $ areq (ciField & addDatalist userList) (fslpI MsgDummyIdent (mr MsgDummyIdentPlaceholder) & noAutocomplete & addName PostLoginDummy) Nothing + wreq (ciField & addDatalist userList) (fslpI MsgDummyIdent (mr MsgDummyIdentPlaceholder) & noAutocomplete & addName PostLoginDummy) Nothing where userList = fmap mkOptionList . runDB $ withReaderT projectBackend (map toOption <$> selectList [] [Asc UserIdent] :: ReaderT SqlBackend _ [Option UserIdent]) toOption (Entity _ User{..}) = Option userDisplayName userIdent (CI.original userIdent) @@ -36,6 +37,7 @@ dummyLogin :: forall site. , SqlBackendCanRead (YesodPersistBackend site) , RenderMessage site AFormMessage , RenderMessage site DummyMessage + , RenderMessage site (ValueRequired site) , Button site ButtonSubmit ) => AuthPlugin site dummyLogin = AuthPlugin{..} @@ -44,8 +46,8 @@ dummyLogin = AuthPlugin{..} apName = "dummy" apDispatch :: forall m. MonadAuthHandler site m => Text -> [Text] -> m TypedContent - apDispatch "POST" [] = liftSubHandler $ do - ((loginRes, _), _) <- runFormPost $ renderAForm FormStandard dummyForm + apDispatch method [] | encodeUtf8 method == methodPost = liftSubHandler $ do + ((loginRes, _), _) <- runFormPost $ renderWForm FormStandard dummyForm tp <- getRouteToParent case loginRes of FormFailure errs -> do @@ -55,15 +57,16 @@ dummyLogin = AuthPlugin{..} addMessageI Warning MsgDummyNoFormData redirect $ tp LoginR FormSuccess ident -> - setCredsRedirect $ Creds "dummy" (CI.original ident) [] + setCredsRedirect $ Creds apName (CI.original ident) [] + apDispatch _ [] = badMethod apDispatch _ _ = notFound apLogin :: (Route Auth -> Route site) -> WidgetFor site () apLogin toMaster = do - (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard dummyForm + (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderWForm FormStandard dummyForm let loginForm = wrapForm login FormSettings { formMethod = POST - , formAction = Just . SomeRoute . toMaster $ PluginR "dummy" [] + , formAction = Just . SomeRoute . toMaster $ PluginR apName [] , formEncoding = loginEnctype , formAttrs = [("uw-no-navigate-away-prompt","")] , formSubmit = FormSubmit diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 300b20f53..e4f8bbfdd 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -34,8 +34,6 @@ data CampusMessage = MsgCampusIdentPlaceholder | MsgCampusIdent | MsgCampusPassword | MsgCampusPasswordPlaceholder - | MsgCampusSubmit - | MsgCampusInvalidCredentials deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) @@ -152,18 +150,15 @@ campusUserMatr' pool mode campusForm :: ( RenderMessage (HandlerSite m) FormMessage + , RenderMessage (HandlerSite m) (ValueRequired (HandlerSite m)) , RenderMessage (HandlerSite m) CampusMessage , MonadHandler m ) => WForm m (FormResult CampusLogin) campusForm = do MsgRenderer mr <- getMsgRenderer - - ident <- wreq ciField (fslpI MsgCampusIdent (mr MsgCampusIdentPlaceholder) & addAttr "autofocus" "") Nothing - password <- wreq passwordField (fslpI MsgCampusPassword (mr MsgCampusPasswordPlaceholder)) Nothing - - return $ CampusLogin - <$> ident - <*> password + aFormToWForm $ CampusLogin + <$> areq ciField (fslpI MsgCampusIdent (mr MsgCampusIdentPlaceholder) & addAttr "autofocus" "") Nothing + <*> areq passwordField (fslpI MsgCampusPassword (mr MsgCampusPasswordPlaceholder)) Nothing apLdap :: Text apLdap = "LDAP" @@ -172,6 +167,7 @@ campusLogin :: forall site. ( YesodAuth site , RenderMessage site CampusMessage , RenderMessage site AFormMessage + , RenderMessage site (ValueRequired site) , Button site ButtonSubmit ) => Failover (LdapConf, LdapPool) -> FailoverMode -> AuthPlugin site campusLogin pool mode = AuthPlugin{..} @@ -180,38 +176,37 @@ campusLogin pool mode = AuthPlugin{..} apName = apLdap apDispatch :: forall m. MonadAuthHandler site m => Text -> [Text] -> m TypedContent - apDispatch "POST" [] = liftSubHandler $ do + apDispatch method [] | encodeUtf8 method == methodPost = liftSubHandler $ do ((loginRes, _), _) <- runFormPost $ renderWForm FormStandard campusForm tp <- getRouteToParent - case loginRes of - FormFailure errs -> do - forM_ errs $ addMessage Error . toHtml - redirect $ tp LoginR - FormMissing -> redirect $ tp LoginR - FormSuccess CampusLogin{ campusIdent = CI.original -> campusIdent, ..} -> do - ldapResult <- withLdapFailover _2 pool mode $ \(conf@LdapConf{..}, ldap) -> liftIO $ do - Ldap.bind ldap ldapDn ldapPassword - searchResults <- findUser conf ldap campusIdent [ldapUserPrincipalName] - case searchResults of - [Ldap.SearchEntry (Ldap.Dn userDN) userAttrs] - | [principalName] <- fold [ v | (k, v) <- userAttrs, k == ldapUserPrincipalName ] - , Right credsIdent <- Text.decodeUtf8' principalName - -> Right (userDN, credsIdent) <$ Ldap.bind ldap (Ldap.Dn credsIdent) (Ldap.Password $ Text.encodeUtf8 campusPassword) - other -> return $ Left other - case ldapResult of - Left err - | LdapError (Ldap.ResponseError (Ldap.ResponseErrorCode _ Ldap.InvalidCredentials _ _)) <- err - -> do - $logDebugS "LDAP" "Invalid credentials" - loginErrorMessageI LoginR Msg.InvalidLogin - | otherwise -> do - $logErrorS "LDAP" $ "Error during login: " <> tshow err - loginErrorMessageI LoginR Msg.AuthError - Right (Right (userDN, credsIdent)) -> - setCredsRedirect $ Creds apName credsIdent [("DN", userDN)] - Right (Left searchResults) -> do - $logWarnS "LDAP" $ "Could not extract principal name: " <> tshow searchResults - loginErrorMessageI LoginR Msg.AuthError + + resp <- formResultMaybe loginRes $ \CampusLogin{ campusIdent = CI.original -> campusIdent, ..} -> Just <$> do + ldapResult <- withLdapFailover _2 pool mode $ \(conf@LdapConf{..}, ldap) -> liftIO $ do + Ldap.bind ldap ldapDn ldapPassword + searchResults <- findUser conf ldap campusIdent [ldapUserPrincipalName] + case searchResults of + [Ldap.SearchEntry (Ldap.Dn userDN) userAttrs] + | [principalName] <- fold [ v | (k, v) <- userAttrs, k == ldapUserPrincipalName ] + , Right credsIdent <- Text.decodeUtf8' principalName + -> Right (userDN, credsIdent) <$ Ldap.bind ldap (Ldap.Dn credsIdent) (Ldap.Password $ Text.encodeUtf8 campusPassword) + other -> return $ Left other + case ldapResult of + Left err + | LdapError (Ldap.ResponseError (Ldap.ResponseErrorCode _ Ldap.InvalidCredentials _ _)) <- err + -> do + $logDebugS "LDAP" "Invalid credentials" + loginErrorMessageI LoginR Msg.InvalidLogin + | otherwise -> do + $logErrorS "LDAP" $ "Error during login: " <> tshow err + loginErrorMessageI LoginR Msg.AuthError + Right (Right (userDN, credsIdent)) -> + setCredsRedirect $ Creds apName credsIdent [("DN", userDN)] + Right (Left searchResults) -> do + $logWarnS "LDAP" $ "Could not extract principal name: " <> tshow searchResults + loginErrorMessageI LoginR Msg.AuthError + + maybe (redirect $ tp LoginR) return resp + apDispatch _ [] = badMethod apDispatch _ _ = notFound apLogin :: (Route Auth -> Route site) -> WidgetFor site () diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs index 2812b67eb..da0b94f22 100644 --- a/src/Auth/PWHash.hs +++ b/src/Auth/PWHash.hs @@ -28,11 +28,12 @@ data PWHashMessage = MsgPWHashIdent hashForm :: ( RenderMessage (HandlerSite m) FormMessage + , RenderMessage (HandlerSite m) (ValueRequired (HandlerSite m)) , RenderMessage (HandlerSite m) PWHashMessage , MonadHandler m - ) => AForm m HashLogin -hashForm = wFormToAForm $ do - mr <- getMessageRender + ) => WForm m (FormResult HashLogin) +hashForm = do + MsgRenderer mr <- getMsgRenderer aFormToWForm $ HashLogin <$> areq ciField (fslpI MsgPWHashIdent (mr MsgPWHashIdentPlaceholder)) Nothing <*> areq passwordField (fslpI MsgPWHashPassword (mr MsgPWHashPasswordPlaceholder)) Nothing @@ -45,6 +46,7 @@ hashLogin :: forall site. , PersistRecordBackend User (YesodPersistBackend site) , RenderMessage site PWHashMessage , RenderMessage site AFormMessage + , RenderMessage site (ValueRequired site) , Button site ButtonSubmit ) => PWHashAlgorithm -> AuthPlugin site hashLogin pwHashAlgo = AuthPlugin{..} @@ -53,31 +55,30 @@ hashLogin pwHashAlgo = AuthPlugin{..} apName = "PWHash" apDispatch :: forall m. MonadAuthHandler site m => Text -> [Text] -> m TypedContent - apDispatch "POST" [] = liftSubHandler $ do - ((loginRes, _), _) <- runFormPost $ renderAForm FormStandard hashForm + apDispatch method [] | encodeUtf8 method == methodPost = liftSubHandler $ do + ((loginRes, _), _) <- runFormPost $ renderWForm FormStandard hashForm tp <- getRouteToParent - case loginRes of - FormFailure errs -> do - forM_ errs $ addMessage Error . toHtml - redirect $ tp LoginR - FormMissing -> redirect $ tp LoginR - FormSuccess HashLogin{..} -> do - user <- liftHandler . runDB . getBy $ UniqueAuthentication hashIdent - case user of - Just (Entity _ User{ userAuthentication = AuthPWHash{..}, userIdent = CI.original -> userIdent }) - | verifyPasswordWith pwHashAlgo (2^) (encodeUtf8 hashPassword) (encodeUtf8 authPWHash) -> -- (2^) is magic. - setCredsRedirect $ Creds apName userIdent [] - other -> do - $logDebugS "PWHash" $ tshow other - loginErrorMessageI LoginR Msg.InvalidLogin + + resp <- formResultMaybe loginRes $ \HashLogin{..} -> Just <$> do + user <- liftHandler . runDB . getBy $ UniqueAuthentication hashIdent + case user of + Just (Entity _ User{ userAuthentication = AuthPWHash{..}, userIdent = CI.original -> userIdent }) + | verifyPasswordWith pwHashAlgo (2^) (encodeUtf8 hashPassword) (encodeUtf8 authPWHash) -> -- (2^) is magic. + setCredsRedirect $ Creds apName userIdent [] + other -> do + $logDebugS "PWHash" $ tshow other + loginErrorMessageI LoginR Msg.InvalidLogin + + maybe (redirect $ tp LoginR) return resp + apDispatch _ [] = badMethod apDispatch _ _ = notFound apLogin :: (Route Auth -> Route site) -> WidgetFor site () apLogin toMaster = do - (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard hashForm + (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderWForm FormStandard hashForm let loginForm = wrapForm login FormSettings { formMethod = POST - , formAction = Just . SomeRoute . toMaster $ PluginR "PWHash" [] + , formAction = Just . SomeRoute . toMaster $ PluginR apName [] , formEncoding = loginEnctype , formAttrs = [("uw-no-navigate-away-prompt","")] , formSubmit = FormSubmit diff --git a/src/Foundation.hs b/src/Foundation.hs index 4f5ae399e..299d1d9aa 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -81,8 +81,6 @@ import Utils.Metrics import Text.Cassius (cassiusFile) -import Yesod.Form.I18n.German -import Yesod.Form.I18n.English import qualified Yesod.Auth.Message as Auth import qualified Data.Conduit.List as C @@ -239,15 +237,7 @@ appLanguagesOpts = do } langOptions = map mkOption $ toList appLanguages return $ mkOptionList langOptions - --- This instance is required to use forms. You can modify renderMessage to --- achieve customized and internationalized form validation messages. -instance RenderMessage UniWorX FormMessage where - renderMessage _ ls = case lang of - ("en" : _) -> englishFormMessage - _other -> germanFormMessage - where lang = Text.splitOn "-" $ selectLanguage' appLanguages ls - + instance RenderMessage UniWorX WeekDay where renderMessage _ ls wDay = pack . fst $ wDays (getTimeLocale' ls) !! (fromEnum wDay `mod` 7) @@ -256,6 +246,7 @@ newtype ShortWeekDay = ShortWeekDay { longWeekDay :: WeekDay } instance RenderMessage UniWorX ShortWeekDay where renderMessage _ ls (ShortWeekDay wDay) = pack . snd $ wDays (getTimeLocale' ls) !! (fromEnum wDay `mod` 7) + -- Access Control newtype InvalidAuthTag = InvalidAuthTag Text deriving (Eq, Ord, Show, Read, Generic, Typeable) diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 2b505386c..fb353c46b 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -34,6 +34,9 @@ import Utils.Form import GHC.Exts (IsList(..)) +import Yesod.Form.I18n.German +import Yesod.Form.I18n.English + appLanguages :: NonEmpty Lang appLanguages = "de-de-formal" :| ["en-eu"] @@ -324,3 +327,26 @@ instance RenderMessage UniWorX UniWorXMessages where uniworxMessages :: [UniWorXMessage] -> UniWorXMessages uniworxMessages = UniWorXMessages . map SomeMessage + + +-- This instance is required to use forms. You can modify renderMessage to +-- achieve customized and internationalized form validation messages. +instance RenderMessage UniWorX FormMessage where + renderMessage _ ls | lang == "en" = englishFormMessage + | otherwise = germanFormMessage + where lang = selectLanguage' ("de" :| ["en"]) ls + +instance RenderMessage UniWorX (ValueRequired UniWorX) where + renderMessage foundation ls (ValueRequired label') + | [w] <- Text.words label + , let w' = Text.strip w + , not $ Text.null w' + = mr $ MsgValueRequiredLabeledSimple w' + | Text.null $ Text.strip label + = mr MsgValueRequired + | otherwise + = mr . MsgValueRequiredLabeledMultiWord $ Text.strip label + where + label = mr label' + mr :: forall msg. RenderMessage UniWorX msg => msg -> Text + mr = renderMessage foundation ls diff --git a/src/Handler/Admin/StudyFeatures.hs b/src/Handler/Admin/StudyFeatures.hs index e21ae568b..0dfd105b8 100644 --- a/src/Handler/Admin/StudyFeatures.hs +++ b/src/Handler/Admin/StudyFeatures.hs @@ -250,7 +250,7 @@ postAdminFeaturesR = do -> DBRow r -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r))) textInputCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex) - (\row _mkUnique -> bimap (fmap $ set lensRes . assertM (not . Text.null)) fvInput + (\row _mkUnique -> bimap (fmap $ set lensRes . assertM (not . Text.null)) fvWidget <$> mopt (textField & cfStrip) "" (Just $ row ^. lensDefault) ) @@ -261,7 +261,7 @@ postAdminFeaturesR = do -> DBRow r -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r))) checkboxCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex) - ( \row _mkUnique -> bimap (fmap $ set lensRes) fvInput + ( \row _mkUnique -> bimap (fmap $ set lensRes) fvWidget <$> mpopt checkBoxField "" (Just $ row ^. lensDefault) ) @@ -272,7 +272,7 @@ postAdminFeaturesR = do -- -> DBRow r -- -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r))) -- termKeyCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex) - -- ( \row _mkUnique -> (\(res, fieldView) -> (set lensRes <$> res, fvInput fieldView)) + -- ( \row _mkUnique -> (\(res, fieldView) -> (set lensRes <$> res, fvWidget fieldView)) -- <$> mopt (intField & isoField (from _StudyTermsId)) "" (Just $ row ^. lensDefault) -- ) @@ -283,10 +283,11 @@ postAdminFeaturesR = do -> DBRow r -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r))) parentsCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex) - ( \row mkUnique -> bimap (fmap $ set lensRes . Set.fromList) fvInput + ( \row mkUnique -> bimap (fmap $ set lensRes . Set.fromList) fvWidget <$> massInputList (intField & isoField (from _StudyTermsId)) (const "") + MsgStudyTermsParentMissing (Just . SomeRoute . (AdminFeaturesR :#:)) (mkUnique ("parents" :: Text)) "" @@ -302,7 +303,7 @@ postAdminFeaturesR = do -> DBRow r -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r))) degreeCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex) - ( \row _mkUnique -> bimap (fmap $ set lensRes) fvInput + ( \row _mkUnique -> bimap (fmap $ set lensRes) fvWidget <$> mopt degreeField "" (Just $ row ^. lensDefault) ) @@ -313,7 +314,7 @@ postAdminFeaturesR = do -> DBRow r -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r))) fieldTypeCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex) - ( \row _mkUnique -> bimap (fmap $ set lensRes) fvInput + ( \row _mkUnique -> bimap (fmap $ set lensRes) fvWidget <$> mopt (selectField optionsFinite) "" (Just $ row ^. lensDefault) ) diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs index 77f468602..c31fd691b 100644 --- a/src/Handler/Admin/Test.hs +++ b/src/Handler/Admin/Test.hs @@ -157,7 +157,7 @@ postAdminTestR = do (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing -- Any old field; for demonstration let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes -- Do something semi-interesting on the result of the @textField@ to demonstrate that further processing can be done addRes'' = addRes' <&> \dat prev -> FormSuccess (Map.singleton (maybe 0 (succ . fst) $ Map.lookupMax prev) dat) -- Construct the callback to determine new cell positions and data within @FormResult@ as required, nested @FormResult@ allows aborting the add depending on previous data - return (addRes'', toWidget csrf >> fvInput addView >> fvInput submitBtn) + return (addRes'', toWidget csrf >> fvWidget addView >> fvWidget submitBtn) mkAddForm _pos _dim _ _ = error "Dimension and Position is always 0 for our 1-dimensional form" -- | Make a single massInput-Cell @@ -170,7 +170,7 @@ postAdminTestR = do -> Form Int mkCellForm _pos cData initial nudge csrf = do -- Extremely simple cell (intRes, intView) <- mreq intField ("" & addName (nudge "int")) $ initial <|> Just cData - return (intRes, toWidget csrf >> fvInput intView) + return (intRes, toWidget csrf >> fvWidget intView) -- | How does the shape (`ListLength`) change if a certain cell is deleted? deleteCell :: Map ListPosition Int -- ^ Current shape, including initialisation data -> ListPosition -- ^ Coordinate to delete @@ -185,7 +185,7 @@ postAdminTestR = do -- The actual call to @massInput@ is comparatively simple: - ((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing + ((miResult, fvWidget -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing testDownloadWidget <- testDownload diff --git a/src/Handler/Admin/Tokens.hs b/src/Handler/Admin/Tokens.hs index 4c847d3a6..4a9427598 100644 --- a/src/Handler/Admin/Tokens.hs +++ b/src/Handler/Admin/Tokens.hs @@ -31,13 +31,13 @@ bearerTokenForm = do muid <- maybeAuthId mr <- getMessageRender - btfAuthorityGroups <- aFormToWForm $ HashSet.fromList . map Left <$> massInputListA pathPieceField (const "") (\p -> Just . SomeRoute $ AdminTokensR :#: p) ("token-groups" :: Text) (fslI MsgBearerTokenAuthorityGroups & setTooltip MsgBearerTokenAuthorityGroupsTip) False Nothing + btfAuthorityGroups <- aFormToWForm $ HashSet.fromList . map Left <$> massInputListA pathPieceField (const "") MsgBearerTokenAuthorityGroupMissing (\p -> Just . SomeRoute $ AdminTokensR :#: p) ("token-groups" :: Text) (fslI MsgBearerTokenAuthorityGroups & setTooltip MsgBearerTokenAuthorityGroupsTip) False Nothing btfAuthorityUsers <- fmap (fmap . ofoldMap $ HashSet.singleton . Right) <$> wopt (checkMap (foldMapM $ fmap Set.singleton . left MsgBearerTokenAuthorityUnknownUser) (Set.map Right) $ multiUserField False Nothing) (fslpI MsgBearerTokenAuthorityUsers (mr MsgLdapIdentificationOrEmail) & setTooltip MsgBearerTokenAuthorityUsersTip) (Just $ Set.singleton <$> muid) let btfAuthority' :: FormResult (HashSet (Either UserGroupName UserId)) btfAuthority' = (<>) <$> btfAuthorityGroups <*> ((hoistMaybe =<< btfAuthorityUsers) <|> pure HashSet.empty) - let btfRoutesForm = HashSet.fromList <$> massInputListA routeField (const "") (\p -> Just . SomeRoute $ AdminTokensR :#: p) ("token-routes" :: Text) (fslI MsgBearerTokenRoutes & setTooltip MsgBearerTokenRoutesTip) True Nothing + let btfRoutesForm = HashSet.fromList <$> massInputListA routeField (const "") MsgBearerTokenRouteMissing (\p -> Just . SomeRoute $ AdminTokensR :#: p) ("token-routes" :: Text) (fslI MsgBearerTokenRoutes & setTooltip MsgBearerTokenRoutesTip) True Nothing btfRoutes' <- optionalActionW btfRoutesForm (fslI MsgBearerTokenRestrictRoutes) (Just True) let btfRestrictForm = massInputAccumEditW miAdd' miCell' (\p -> Just . SomeRoute $ AdminTokensR :#: p) miLayout' ("token-restrictions" :: Text) (fslI MsgBearerTokenRestrictions) False Nothing @@ -48,8 +48,8 @@ bearerTokenForm = do -> Either (FieldView UniWorX) (Route UniWorX, Value) -> Form (Route UniWorX, Value) miForm nudge mode csrf = do - (routeRes, routeView) <- mpreq routeField ("" & addName (nudge "route")) (mode ^? _Right . _1) - (restrRes, restrView) <- mpreq (checkMap (left Text.pack . Aeson.eitherDecode . encodeUtf8 . fromStrict . unTextarea) (Textarea . toStrict . decodeUtf8 . Aeson.encodePretty) textareaField) ("" & addName (nudge "restr")) (mode ^? _Right . _2) + (routeRes, routeView) <- mpreq routeField (fslI MsgBearerTokenRestrictRoute & addName (nudge "route")) (mode ^? _Right . _1) + (restrRes, restrView) <- mpreq (checkMap (left Text.pack . Aeson.eitherDecode . encodeUtf8 . fromStrict . unTextarea) (Textarea . toStrict . decodeUtf8 . Aeson.encodePretty) textareaField) (fslI MsgBearerTokenRestrictValue & addName (nudge "restr")) (mode ^? _Right . _2) return ((,) <$> routeRes <*> restrRes, case mode of Left btn -> $(widgetFile "widgets/massinput/token-restrictions/add") diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 63df0d449..94da99e6a 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -217,14 +217,14 @@ colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_ colRatedField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (Bool, a, b) CorrectionTableData))) colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell id (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId) - (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done)) + (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done)) colPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData))) colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell id (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId) (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _, _, _) } mkUnique -> case sheetType of NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty) - _other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) (fsUniq mkUnique "points") (Just submissionRatingPoints) + _other -> over (_1.mapped) (_2 .~) . over _2 fvWidget <$> mopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) (fsUniq mkUnique "points") (Just submissionRatingPoints) ) colMaxPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData))) @@ -233,7 +233,7 @@ colMaxPointsField = sortable (Just "sheet-type") (i18nCell MsgSheetType) $ i18nC colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData))) colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ fmap (cellAttrs <>~ [("style","width:60%")]) $ formCell id (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId) - (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment)) + (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment)) colLastEdit :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colLastEdit = sortable (Just "last-edit") (i18nCell MsgLastEdit) $ diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index b9d82105d..a867bba49 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -128,7 +128,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB let miAdd :: ListPosition -> Natural -> (Text -> Text) -> FieldView UniWorX -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId)))) miAdd _ _ nudge btn = Just $ \csrf -> do - (addRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + (addRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) (fslI MsgCourseLecturerEmail & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing let addRes'' = addRes <&> \newDat oldDat -> if | existing <- newDat `Set.intersection` Set.fromList (Map.elems oldDat) , not $ Set.null existing @@ -140,7 +140,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB miCell :: ListPosition -> Either UserEmail UserId -> Maybe (Maybe LecturerType) -> (Text -> Text) -> Form (Maybe LecturerType) miCell _ (Right lid) defType nudge = \csrf -> do - (lrwRes,lrwView) <- mreq (selectField optionsFinite) ("" & addName (nudge "lecturer-type")) (join defType) + (lrwRes,lrwView) <- mreq (selectField optionsFinite) (fslI MsgLecturerType & addName (nudge "lecturer-type")) (join defType) User{userEmail, userDisplayName, userSurname} <- liftHandler . runDB $ get404 lid let lrwView' = $(widgetFile "course/lecturerMassInput/cellKnown") return (Just <$> lrwRes,lrwView') diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs index ba223ceaa..7d79c51bb 100644 --- a/src/Handler/Course/User.hs +++ b/src/Handler/Course/User.hs @@ -103,7 +103,7 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex = ((regFieldRes, regFieldView), regFieldEnctype) <- lift . runFormPost . identifyForm FIDcRegField $ \csrf -> let currentField :: Maybe (Maybe StudyFeaturesId) currentField = courseParticipantField . entityVal <$> mRegistration - in over _2 ((toWidget csrf <>) . fvInput) <$> mreq (studyFeaturesFieldFor Nothing True (maybeToList $ join currentField) $ Just uid) ("" & addAutosubmit) currentField + in over _2 ((toWidget csrf <>) . fvWidget) <$> mreq (studyFeaturesFieldFor Nothing True (maybeToList $ join currentField) $ Just uid) ("" & addAutosubmit) currentField let registrationFieldFrag :: Text registrationFieldFrag = "registration-field" diff --git a/src/Handler/Exam/AutoOccurrence.hs b/src/Handler/Exam/AutoOccurrence.hs index 6354b2dcd..1f38a7910 100644 --- a/src/Handler/Exam/AutoOccurrence.hs +++ b/src/Handler/Exam/AutoOccurrence.hs @@ -77,7 +77,7 @@ examAutoOccurrenceAcceptForm :: Maybe ExamAutoOccurrenceAcceptForm -> Form ExamA examAutoOccurrenceAcceptForm confirmData = identifyForm FIDExamAutoOccurrenceConfirm $ \html -> do (confirmDataRes, confirmDataView) <- mreq secretJsonField "" confirmData (acceptRes, acceptView) <- buttonForm' [BtnExamAutoOccurrenceAccept] mempty - return (acceptRes *> confirmDataRes, toWidget html <> fvInput confirmDataView <> acceptView) + return (acceptRes *> confirmDataRes, toWidget html <> fvWidget confirmDataView <> acceptView) examAutoOccurrenceCalculateWidget :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Widget diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index c43706c03..d5781165c 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -114,7 +114,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) miAdd' nudge submitView csrf = do - (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser $ Just corrUserSuggestions) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser $ Just corrUserSuggestions) (fslI MsgExamCorrectorEmail & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing let addRes' | otherwise @@ -160,12 +160,12 @@ examOccurrenceForm prev = wFormToAForm $ do where examOccurrenceForm' nudge mPrev csrf = do (eofIdRes, eofIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ eofId =<< mPrev) - (eofNameRes, eofNameView) <- mpreq (textField & cfStrip & cfCI) ("" & addName (nudge "name")) (eofName <$> mPrev) - (eofRoomRes, eofRoomView) <- mpreq (textField & cfStrip) ("" & addName (nudge "room")) (eofRoom <$> mPrev) - (eofCapacityRes, eofCapacityView) <- mpreq (natFieldI MsgExamRoomCapacityNegative) ("" & addName (nudge "capacity")) (eofCapacity <$> mPrev) - (eofStartRes, eofStartView) <- mpreq utcTimeField ("" & addName (nudge "start")) (eofStart <$> mPrev) - (eofEndRes, eofEndView) <- mopt utcTimeField ("" & addName (nudge "end")) (eofEnd <$> mPrev) - (eofDescRes, eofDescView) <- mopt htmlFieldSmall ("" & addName (nudge "description")) (eofDescription <$> mPrev) + (eofNameRes, eofNameView) <- mpreq (textField & cfStrip & cfCI) (fslI MsgExamRoomName & addName (nudge "name")) (eofName <$> mPrev) + (eofRoomRes, eofRoomView) <- mpreq (textField & cfStrip) (fslI MsgExamRoomRoom & addName (nudge "room")) (eofRoom <$> mPrev) + (eofCapacityRes, eofCapacityView) <- mpreq (natFieldI MsgExamRoomCapacityNegative) (fslI MsgExamRoomCapacity & addName (nudge "capacity")) (eofCapacity <$> mPrev) + (eofStartRes, eofStartView) <- mpreq utcTimeField (fslI MsgExamRoomStart & addName (nudge "start")) (eofStart <$> mPrev) + (eofEndRes, eofEndView) <- mopt utcTimeField (fslI MsgExamRoomEnd & addName (nudge "end")) (eofEnd <$> mPrev) + (eofDescRes, eofDescView) <- mopt htmlFieldSmall (fslI MsgExamRoomDescription & addName (nudge "description")) (eofDescription <$> mPrev) return ( ExamOccurrenceForm <$> eofIdRes @@ -201,11 +201,11 @@ examPartsForm prev = wFormToAForm $ do fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamParts) False $ Set.toList <$> prev where examPartForm' nudge mPrev csrf = do - (epfIdRes, epfIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ epfId =<< mPrev) - (epfNumberRes, epfNumberView) <- mpreq (isoField (from _ExamPartNumber) $ textField & cfStrip & cfCI) ("" & addName (nudge "number") & addPlaceholder "1, 6a, 3.1.4, ...") (epfNumber <$> mPrev) - (epfNameRes, epfNameView) <- mopt (textField & cfStrip & cfCI) ("" & addName (nudge "name")) (epfName <$> mPrev) - (epfMaxPointsRes, epfMaxPointsView) <- mopt pointsField ("" & addName (nudge "max-points")) (epfMaxPoints <$> mPrev) - (epfWeightRes, epfWeightView) <- mpreq (checkBool (>= 0) MsgExamPartWeightNegative rationalField) ("" & addName (nudge "weight")) (epfWeight <$> mPrev <|> Just 1) + (epfIdRes, epfIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ epfId =<< mPrev) + (epfNumberRes, epfNumberView) <- mpreq (isoField (from _ExamPartNumber) $ textField & cfStrip & cfCI) (fslI MsgExamPartNumber & addName (nudge "number") & addPlaceholder "1, 6a, 3.1.4, ...") (epfNumber <$> mPrev) + (epfNameRes, epfNameView) <- mopt (textField & cfStrip & cfCI) (fslI MsgExamPartName & addName (nudge "name")) (epfName <$> mPrev) + (epfMaxPointsRes, epfMaxPointsView) <- mopt pointsField (fslI MsgExamPartMaxPoints & addName (nudge "max-points")) (epfMaxPoints <$> mPrev) + (epfWeightRes, epfWeightView) <- mpreq (checkBool (>= 0) MsgExamPartWeightNegative rationalField) (fslI MsgExamPartWeight & addName (nudge "weight")) (epfWeight <$> mPrev <|> Just 1) return ( ExamPartForm <$> epfIdRes diff --git a/src/Handler/ExamOffice/Users.hs b/src/Handler/ExamOffice/Users.hs index 4ec34607b..878e228b2 100644 --- a/src/Handler/ExamOffice/Users.hs +++ b/src/Handler/ExamOffice/Users.hs @@ -95,7 +95,7 @@ makeExamOfficeUsersForm template = renderWForm FormStandard $ do -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) miAdd' nudge btn csrf = do MsgRenderer mr <- getMsgRenderer - (addRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) ("" & addName (nudge "users") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + (addRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) (fslI MsgExamOfficeUserEmail & addName (nudge "users") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing let res' :: FormResult ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) res' = addRes <&> \newUsers oldUsers -> if diff --git a/src/Handler/ExternalExam/Form.hs b/src/Handler/ExternalExam/Form.hs index 4b7ec6eb7..93c4273d5 100644 --- a/src/Handler/ExternalExam/Form.hs +++ b/src/Handler/ExternalExam/Form.hs @@ -72,11 +72,12 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do miIdent = "external-exams-school" fSettings = fslI MsgExternalExamExamOfficeSchools & setTooltip MsgExternalExamExamOfficeSchoolsTip fRequired = False + staffForm :: Route UniWorX -> Maybe [Either UserEmail UserId] -> AForm Handler [Either UserEmail UserId] staffForm cRoute = massInputAccumA miAdd miCell miButtonAction miLayout miIdent fSettings fRequired where miAdd mkUnique submitView csrf = do MsgRenderer mr <- getMsgRenderer - (usersRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) ("" & addName (mkUnique "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + (usersRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) (fslI MsgExternalExamStaffEmail & addName (mkUnique "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing let usersRes' = usersRes <&> \newDat oldDat -> if | existing <- newDat `Set.intersection` Set.fromList oldDat diff --git a/src/Handler/School.hs b/src/Handler/School.hs index ba4ebdd22..72de78d79 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -68,7 +68,7 @@ mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh (textField & cfStrip & cfCI) (fslI MsgSchoolShort) <*> areq (textField & cfStrip & cfCI) (fslI MsgSchoolName) (sfName <$> template) - <*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip . CI.original) <$> massInputListA (ciField & addDatalist ldapOrgs) (const "") (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (Set.toList . sfOrgUnits <$> template)) + <*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip . CI.original) <$> massInputListA (ciField & addDatalist ldapOrgs) (const "") MsgSchoolLdapOrganisationMissing (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (Set.toList . sfOrgUnits <$> template)) where ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text)) ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $ diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 52454e757..aa610b6e7 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -420,7 +420,7 @@ getSShowR tid ssh csh shn = do Entity _ SheetPseudonym{sheetPseudonymPseudonym} <- MaybeT . runDB . getBy $ UniqueSheetPseudonymUser sid uid return $ review _PseudonymText sheetPseudonymPseudonym (generateWidget, generateEnctype) <- generateFormPost $ \csrf -> - over _2 ((toWidget csrf <>) . fvInput) <$> mreq (buttonField BtnGenerate) "" Nothing + over _2 ((toWidget csrf <>) . fvWidget) <$> mreq (buttonField BtnGenerate) "" Nothing let generateForm = wrapForm generateWidget def { formAction = Just . SomeRoute $ CSheetR tid ssh csh shn SPseudonymR , formEncoding = generateEnctype @@ -760,9 +760,9 @@ correctorForm loads' = wFormToAForm $ do -> (Text -> Text) -> Form (CorrectorState, Load) miCell _ userIdent initRes nudge csrf = do - (stateRes, stateView) <- mreq (selectField optionsFinite) ("" & addName (nudge "state")) $ (fst <$> initRes) <|> Just CorrectorNormal + (stateRes, stateView) <- mreq (selectField optionsFinite) (fslI MsgSheetCorrectorState & addName (nudge "state")) $ (fst <$> initRes) <|> Just CorrectorNormal (byTutRes, byTutView) <- mreq checkBoxField ("" & addName (nudge "bytut")) $ (isJust . byTutorial . snd <$> initRes) <|> Just False - (propRes, propView) <- mreq (checkBool (>= 0) MsgProportionNegative $ rationalField) ("" & addName (nudge "prop")) $ (byProportion . snd <$> initRes) <|> Just 0 + (propRes, propView) <- mreq (checkBool (>= 0) MsgProportionNegative $ rationalField) (fslI MsgSheetCorrectorProportion & addName (nudge "prop")) $ (byProportion . snd <$> initRes) <|> Just 0 let res :: FormResult (CorrectorState, Load) res = (,) <$> stateRes <*> (Load <$> tutRes' <*> propRes) diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index f400a18ff..9ca32da9d 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -243,6 +243,7 @@ newTermForm template = validateForm validateTerm $ \html -> do holidayForm = massInputListA dayField (const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder)) + MsgTermHolidayMissing (const Nothing) ("holidays" :: Text) (fslI MsgTermHolidays) diff --git a/src/Handler/Tutorial/Form.hs b/src/Handler/Tutorial/Form.hs index 7c2f7db46..bba53a709 100644 --- a/src/Handler/Tutorial/Form.hs +++ b/src/Handler/Tutorial/Form.hs @@ -40,7 +40,7 @@ tutorialForm cid template html = do where miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) miAdd' nudge submitView csrf = do - (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser . Just $ tutUserSuggestions uid) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing + (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser . Just $ tutUserSuggestions uid) (fslI MsgTutorEmail & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing let addRes' | otherwise diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 0224ca946..bccb6d646 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -42,7 +42,7 @@ import qualified Data.HashSet as HashSet hijackUserForm :: Form () hijackUserForm csrf = do (btnResult, btnView) <- mopt (buttonField BtnHijack) "" Nothing - return (btnResult >>= guard . is _Just, mconcat [toWidget csrf, fvInput btnView]) + return (btnResult >>= guard . is _Just, mconcat [toWidget csrf, fvWidget btnView]) -- In case of refactoring, use this: -- instance HasEntity (DBRow (Entity User)) User where diff --git a/src/Handler/Utils/Delete.hs b/src/Handler/Utils/Delete.hs index a97c830ab..ea5774bd1 100644 --- a/src/Handler/Utils/Delete.hs +++ b/src/Handler/Utils/Delete.hs @@ -73,7 +73,7 @@ confirmForm' drRecords confirmString mmsg = addDeleteTargets . identifyForm FIDD addDeleteTargets :: Form a -> Form a addDeleteTargets form csrf = do (_, fvTargets) <- mreq secretJsonField ("" & addName (toPathPiece PostDeleteTarget)) (Just drRecords) - over _2 (mappend $ fvInput fvTargets) <$> form csrf + over _2 (mappend $ fvWidget fvTargets) <$> form csrf postDeleteR :: ( DeleteCascade record SqlBackend ) diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 7133be3ba..0c950205e 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -635,9 +635,9 @@ uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUp sFileForm :: (Text -> Text) -> Maybe UploadSpecificFile -> Form UploadSpecificFile sFileForm nudge mPrevUF csrf = do - (labelRes, labelView) <- mpreq textField ("" & addName (nudge "label")) $ specificFileLabel <$> mPrevUF - (nameRes, nameView) <- mpreq textField ("" & addName (nudge "name")) $ specificFileName <$> mPrevUF - (reqRes, reqView) <- mpreq checkBoxField ("" & addName (nudge "required")) $ specificFileRequired <$> mPrevUF + (labelRes, labelView) <- mpreq textField (fslI MsgUploadSpecificFileLabel & addName (nudge "label")) $ specificFileLabel <$> mPrevUF + (nameRes, nameView) <- mpreq textField (fslI MsgUploadSpecificFileName & addName (nudge "name")) $ specificFileName <$> mPrevUF + (reqRes, reqView) <- mpreq checkBoxField (fslI MsgUploadSpecificFileRequired & addName (nudge "required")) $ specificFileRequired <$> mPrevUF return ( UploadSpecificFile <$> labelRes <*> nameRes <*> reqRes , $(widgetFile "widgets/massinput/uploadSpecificFiles/form") diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs index e612b5fe7..21f7488e7 100644 --- a/src/Handler/Utils/Form/MassInput.hs +++ b/src/Handler/Utils/Form/MassInput.hs @@ -20,7 +20,7 @@ import Utils.Form import Handler.Utils.Form.MassInput.Liveliness import Handler.Utils.Form.MassInput.TH -import Text.Blaze (Markup) +import Text.Blaze (Markup, toMarkup) import qualified Data.Text as Text @@ -426,7 +426,9 @@ massInput MassInput{ miIdent = toPathPiece -> miIdent, ..} FieldSettings{..} fvR fvLabel = toHtml $ mr fsLabel fvTooltip = toHtml . mr <$> fsTooltip fvInput = $(widgetFile "widgets/massinput/massinput") - fvErrors = Nothing + fvErrors = case result of + FormFailure errs | not $ null errs -> Just . mconcat . intersperse [shamlet|
|] $ map toMarkup errs + _other -> Nothing in return (result, FieldView{..}) defaultMiLayout :: forall liveliness cellData cellResult. @@ -455,24 +457,26 @@ listMiLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/mas -- | Wrapper around `massInput` for the common case, that we just want an arbitrary list of single fields without any constraints -massInputList :: forall handler cellResult ident. +massInputList :: forall handler cellResult ident msg. ( MonadHandler handler, HandlerSite handler ~ UniWorX , MonadThrow handler , PathPiece ident + , RenderMessage UniWorX msg ) => Field handler cellResult -> (ListPosition -> FieldSettings UniWorX) + -> msg -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> ident -> FieldSettings UniWorX -> Bool -> Maybe [cellResult] -> (Markup -> MForm handler (FormResult [cellResult], FieldView UniWorX)) -massInputList field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult = over (mapped . _1 . mapped) (map snd . Map.elems) . massInput +massInputList field fieldSettings onMissing miButtonAction miIdent miSettings miRequired miPrevResult = over (mapped . _1 . mapped) (map snd . Map.elems) . massInput MassInput { miAdd = \_ _ _ submitBtn -> Just $ \csrf -> - return (FormSuccess $ \pRes -> FormSuccess $ Map.singleton (maybe 0 succ . fmap fst $ Map.lookupMax pRes) (), toWidget csrf >> fvInput submitBtn) + return (FormSuccess $ \pRes -> FormSuccess $ Map.singleton (maybe 0 succ . fmap fst $ Map.lookupMax pRes) (), toWidget csrf >> fvWidget submitBtn) , miCell = \pos () iRes nudge csrf -> - over _2 (\FieldView{..} -> $(widgetFile "widgets/massinput/list/cell")) <$> mreq field (fieldSettings pos & addName (nudge "field")) iRes + over _2 (\fv -> $(widgetFile "widgets/massinput/list/cell")) <$> mreqMsg field (fieldSettings pos & addName (nudge "field")) onMissing iRes , miDelete = miDeleteList , miAllowAdd = \_ _ _ -> True , miAddEmpty = \_ _ _ -> Set.empty @@ -484,20 +488,22 @@ massInputList field fieldSettings miButtonAction miIdent miSettings miRequired m miRequired (Map.fromList . zip [0..] . map ((), ) <$> miPrevResult) -massInputListA :: forall handler cellResult ident. +massInputListA :: forall handler cellResult ident msg. ( MonadHandler handler, HandlerSite handler ~ UniWorX , MonadThrow handler , PathPiece ident + , RenderMessage UniWorX msg ) => Field handler cellResult -> (ListPosition -> FieldSettings UniWorX) + -> msg -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> ident -> FieldSettings UniWorX -> Bool -> Maybe [cellResult] -> AForm handler [cellResult] -massInputListA field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult = formToAForm . fmap (over _2 pure) $ massInputList field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult mempty +massInputListA field fieldSettings onMissing miButtonAction miIdent miSettings miRequired miPrevResult = formToAForm . fmap (over _2 pure) $ massInputList field fieldSettings onMissing miButtonAction miIdent miSettings miRequired miPrevResult mempty -- | Wrapper around `massInput` for the common case, that we just want a list of data with no option to modify it except deletion and addition diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index ccd00621d..52a9db794 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -1598,4 +1598,4 @@ dbSelect resLens selLens genIndex = Colonnade.singleton (headednessPure $ mempty where genForm _ mkUnique = do (selResult, selWidget) <- mreq checkBoxField (fsUniq mkUnique "select") (Just False) - return (set selLens <$> selResult, [whamlet|^{fvInput selWidget}|]) + return (set selLens <$> selResult, [whamlet|^{fvWidget selWidget}|]) diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs index 4103d5595..493cdbe53 100644 --- a/src/Import/NoModel.hs +++ b/src/Import/NoModel.hs @@ -18,6 +18,7 @@ import ClassyPrelude.Yesod as Import , embed , try, embed, catches, handle, catch, bracket, bracketOnError, bracket_, catchJust, finally, handleJust, mask, mask_, onException, tryJust, uninterruptibleMask, uninterruptibleMask_ , htmlField, fileField + , mreq, areq, wreq -- Use `mreqMsg`, `areqMsg`, `wreqMsg` ) import UnliftIO.Async.Utils as Import diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index a213a6e7d..e24753d90 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -4,7 +4,7 @@ module Utils.Form where -import ClassyPrelude.Yesod hiding (addMessage, addMessageI, cons, Proxy(..), identifyForm, addClass) +import ClassyPrelude.Yesod hiding (addMessage, addMessageI, cons, Proxy(..), identifyForm, addClass, mreq, areq, wreq) import qualified Yesod.Form.Functions as Yesod import Yesod.Core.Instances () import Settings @@ -409,7 +409,7 @@ buttonForm' btns csrf = do $newline never #{csrf} $forall bView <- fViews - ^{fvInput bView} + ^{fvWidget bView} |]) withButtonForm' :: (MonadHandler m, Button (HandlerSite m) btn) @@ -932,6 +932,9 @@ formSection formSectionTitle = do , fvInput = mempty }) +fvWidget :: FieldView site -> WidgetFor site () +fvWidget FieldView{..} = $(widgetFile "widgets/field-view/field-view") + ------------------- -- Special Forms -- ------------------- @@ -945,7 +948,7 @@ aformSection' = formToAForm . fmap (second pure) . formSection' -- allows tooltips and arbitrary attributs. Section header must be given through `fsLabel` formSection' :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site FormMessage) => FieldSettings site -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete -formSection' formSectionTitleSettings = mreq noinputField sectionSettings Nothing +formSection' formSectionTitleSettings = Yesod.mreq noinputField sectionSettings Nothing where sectionSettings = formSectionTitleSettings { fsId = Just idFormSectionNoinput } @@ -1157,6 +1160,31 @@ wFormFields = mapRWST (fmap (\((a, s, w'), w) -> ((a, w), s, w')) . censor (cons -- Special variants of @mopt@, @mreq@, ... -- --------------------------------------------- + +data ValueRequired site = forall msg. RenderMessage site msg => ValueRequired msg + +mreq :: forall m a. + ( MonadHandler m + , RenderMessage (HandlerSite m) (ValueRequired (HandlerSite m)) + ) + => Field m a -> FieldSettings (HandlerSite m) -> Maybe a -> MForm m (FormResult a, FieldView (HandlerSite m)) +mreq f fs@FieldSettings{..} mdef = mreqMsg f fs (ValueRequired fsLabel) mdef + +wreq :: forall m a. + ( MonadHandler m + , RenderMessage (HandlerSite m) (ValueRequired (HandlerSite m)) + ) + => Field m a -> FieldSettings (HandlerSite m) -> Maybe a -> WForm m (FormResult a) +wreq f fs@FieldSettings{..} mdef = wreqMsg f fs (ValueRequired fsLabel) mdef + +areq :: forall m a. + ( MonadHandler m + , RenderMessage (HandlerSite m) (ValueRequired (HandlerSite m)) + ) + => Field m a -> FieldSettings (HandlerSite m) -> Maybe a -> AForm m a +areq f fs@FieldSettings{..} mdef = areqMsg f fs (ValueRequired fsLabel) mdef + + mforced :: (site ~ HandlerSite m, MonadHandler m) => Field m a -> FieldSettings site -> a -> MForm m (FormResult a, FieldView site) mforced Field{..} FieldSettings{..} val = do @@ -1223,13 +1251,13 @@ wforcedJust f fs (Just fDef) = wforced f fs fDef wforcedJust _ _ Nothing = error "wforcedJust called with Nothing" -mpreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m) +mpreq :: (RenderMessage site (ValueRequired site), HandlerSite m ~ site, MonadHandler m) => Field m a -> FieldSettings site -> Maybe a -> MForm m (FormResult a, FieldView site) -- ^ Pseudo required -- -- `FieldView` has `fvRequired` set to `True` and @FormSuccess Nothing@ is cast to `FormFailure`. -- Otherwise acts exactly like `mopt`. -mpreq f fs mx = do +mpreq f fs@FieldSettings{..} mx = do mr <- getMessageRender (res, fv) <- mopt f fs (Just <$> mx) let fv' = fv { fvRequired = True } @@ -1237,22 +1265,33 @@ mpreq f fs mx = do FormSuccess (Just res') -> (FormSuccess res', fv') FormSuccess Nothing - -> (FormFailure [mr MsgValueRequired], fv' { fvErrors = Just . toHtml $ mr MsgValueRequired }) + -> let errMsg = mr $ ValueRequired fsLabel + in ( FormFailure [errMsg] + , fv' { fvErrors = Just + [shamlet| + $newline never + $maybe pErr <- fvErrors fv' + #{pErr} +
+ #{errMsg} + |] + } + ) FormFailure errs -> (FormFailure errs, fv') FormMissing -> (FormMissing, fv') -apreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m) +apreq :: (RenderMessage site (ValueRequired site), HandlerSite m ~ site, MonadHandler m) => Field m a -> FieldSettings site -> Maybe a -> AForm m a apreq f fs mx = formToAForm $ over _2 pure <$> mpreq f fs mx -wpreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m) +wpreq :: (RenderMessage site (ValueRequired site), HandlerSite m ~ site, MonadHandler m) => Field m a -> FieldSettings site -> Maybe a -> WForm m (FormResult a) wpreq f fs mx = mFormToWForm $ mpreq f fs mx -mpopt :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m) +mpopt :: (RenderMessage site (ValueRequired site), HandlerSite m ~ site, MonadHandler m) => Field m a -> FieldSettings site -> Maybe a -> MForm m (FormResult a, FieldView site) -- ^ Pseudo optional -- @@ -1260,10 +1299,10 @@ mpopt :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m) -- Otherwise acts exactly like `mreq`. mpopt f fs mx = set (_2 . _fvRequired) False <$> mreq f fs mx -apopt :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m) +apopt :: (RenderMessage site (ValueRequired site), HandlerSite m ~ site, MonadHandler m) => Field m a -> FieldSettings site -> Maybe a -> AForm m a apopt f fs mx = formToAForm $ over _2 pure <$> mpopt f fs mx -wpopt :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m) +wpopt :: (RenderMessage site (ValueRequired site), HandlerSite m ~ site, MonadHandler m) => Field m a -> FieldSettings site -> Maybe a -> WForm m (FormResult a) wpopt f fs mx = mFormToWForm $ mpopt f fs mx diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index b9cb8334b..e6cb66f9b 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -84,6 +84,7 @@ data Icon | IconBreadcrumbSeparator | IconMissingAllocationPriority | IconFileUploadSession + | IconStandaloneFieldError deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable) iconText :: Icon -> Text @@ -146,6 +147,7 @@ iconText = \case IconBreadcrumbSeparator -> "angle-right" IconMissingAllocationPriority -> "empty-set" IconFileUploadSession -> "file-upload" + IconStandaloneFieldError -> "exclamation" instance Universe Icon instance Finite Icon diff --git a/templates/allocation/show/course.hamlet b/templates/allocation/show/course.hamlet index 4972ae661..ef2a7341f 100644 --- a/templates/allocation/show/course.hamlet +++ b/templates/allocation/show/course.hamlet @@ -7,7 +7,7 @@ $if is _Just muid _{MsgAllocationPriority}
$maybe prioView <- mApplyFormView' >>= afvPriority - ^{fvInput prioView} + ^{fvWidget prioView} $nothing _{MsgAllocationNoApplication} diff --git a/templates/course/lecturerMassInput/add.hamlet b/templates/course/lecturerMassInput/add.hamlet index da5411bc4..879d67f4f 100644 --- a/templates/course/lecturerMassInput/add.hamlet +++ b/templates/course/lecturerMassInput/add.hamlet @@ -1,6 +1,6 @@ $newline never #{csrf} - ^{fvInput addView} + ^{fvWidget addView} - ^{fvInput btn} + ^{fvWidget btn} diff --git a/templates/course/lecturerMassInput/cellInvitation.hamlet b/templates/course/lecturerMassInput/cellInvitation.hamlet index d1bc53f51..6e95bcf1f 100644 --- a/templates/course/lecturerMassInput/cellInvitation.hamlet +++ b/templates/course/lecturerMassInput/cellInvitation.hamlet @@ -6,4 +6,4 @@ ^{messageTooltip invWarnMsg} - ^{fvInput lrwView} + ^{fvWidget lrwView} diff --git a/templates/course/lecturerMassInput/cellKnown.hamlet b/templates/course/lecturerMassInput/cellKnown.hamlet index 0b55c7902..1aa72293f 100644 --- a/templates/course/lecturerMassInput/cellKnown.hamlet +++ b/templates/course/lecturerMassInput/cellKnown.hamlet @@ -3,4 +3,4 @@ $newline never #{csrf} ^{nameEmailWidget userEmail userDisplayName userSurname} # - ^{fvInput lrwView} + ^{fvWidget lrwView} diff --git a/templates/course/lecturerMassInput/layout.hamlet b/templates/course/lecturerMassInput/layout.hamlet index 65352dd95..1472ccc6c 100644 --- a/templates/course/lecturerMassInput/layout.hamlet +++ b/templates/course/lecturerMassInput/layout.hamlet @@ -5,7 +5,7 @@ $newline never ^{cellWdgts ! coord} - ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)} ^{addWdgts ! (0, 0)} diff --git a/templates/external-exam/schoolMassInput/add.hamlet b/templates/external-exam/schoolMassInput/add.hamlet index cf4cc6e72..2fca7d4c3 100644 --- a/templates/external-exam/schoolMassInput/add.hamlet +++ b/templates/external-exam/schoolMassInput/add.hamlet @@ -1,6 +1,6 @@ $newline never #{csrf} - ^{fvInput addView} + ^{fvWidget addView} - ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/external-exam/schoolMassInput/layout.hamlet b/templates/external-exam/schoolMassInput/layout.hamlet index 65352dd95..1472ccc6c 100644 --- a/templates/external-exam/schoolMassInput/layout.hamlet +++ b/templates/external-exam/schoolMassInput/layout.hamlet @@ -5,7 +5,7 @@ $newline never ^{cellWdgts ! coord} - ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)} ^{addWdgts ! (0, 0)} diff --git a/templates/external-exam/staffMassInput/add.hamlet b/templates/external-exam/staffMassInput/add.hamlet index bdf6da247..7a95b3019 100644 --- a/templates/external-exam/staffMassInput/add.hamlet +++ b/templates/external-exam/staffMassInput/add.hamlet @@ -1,6 +1,6 @@ $newline never #{csrf} - ^{fvInput addView} + ^{fvWidget addView} - ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/external-exam/staffMassInput/layout.hamlet b/templates/external-exam/staffMassInput/layout.hamlet index 65352dd95..1472ccc6c 100644 --- a/templates/external-exam/staffMassInput/layout.hamlet +++ b/templates/external-exam/staffMassInput/layout.hamlet @@ -5,7 +5,7 @@ $newline never ^{cellWdgts ! coord} - ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)} ^{addWdgts ! (0, 0)} diff --git a/templates/sheetCorrectors/add.hamlet b/templates/sheetCorrectors/add.hamlet index 3ad3f5fa8..52ca70f42 100644 --- a/templates/sheetCorrectors/add.hamlet +++ b/templates/sheetCorrectors/add.hamlet @@ -1,6 +1,6 @@ $newline never #{csrf} - ^{fvInput addView} + ^{fvWidget addView} - ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/sheetCorrectors/cell.hamlet b/templates/sheetCorrectors/cell.hamlet index 226cdadd9..6e6822a89 100644 --- a/templates/sheetCorrectors/cell.hamlet +++ b/templates/sheetCorrectors/cell.hamlet @@ -10,8 +10,8 @@ $case userIdent ^{identWidget} #{csrf} - ^{fvInput stateView} + ^{fvWidget stateView} - ^{fvInput byTutView} + ^{fvWidget byTutView} - ^{fvInput propView} + ^{fvWidget propView} diff --git a/templates/sheetCorrectors/layout.hamlet b/templates/sheetCorrectors/layout.hamlet index 172f813f8..4f94d0bd6 100644 --- a/templates/sheetCorrectors/layout.hamlet +++ b/templates/sheetCorrectors/layout.hamlet @@ -12,7 +12,7 @@ $newline never ^{cellWdgts ! coord} - ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)} ^{addWdgts ! (0, 0)} diff --git a/templates/tutorial/tutorMassInput/add.hamlet b/templates/tutorial/tutorMassInput/add.hamlet index bdf6da247..7a95b3019 100644 --- a/templates/tutorial/tutorMassInput/add.hamlet +++ b/templates/tutorial/tutorMassInput/add.hamlet @@ -1,6 +1,6 @@ $newline never #{csrf} - ^{fvInput addView} + ^{fvWidget addView} - ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/tutorial/tutorMassInput/layout.hamlet b/templates/tutorial/tutorMassInput/layout.hamlet index 65352dd95..1472ccc6c 100644 --- a/templates/tutorial/tutorMassInput/layout.hamlet +++ b/templates/tutorial/tutorMassInput/layout.hamlet @@ -5,7 +5,7 @@ $newline never ^{cellWdgts ! coord} - ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)} ^{addWdgts ! (0, 0)} diff --git a/templates/widgets/aform/aform.hamlet b/templates/widgets/aform/aform.hamlet index c492b61d7..ad026d02c 100644 --- a/templates/widgets/aform/aform.hamlet +++ b/templates/widgets/aform/aform.hamlet @@ -28,7 +28,8 @@ $case formLayout
^{fvInput view} $maybe err <- fvErrors view -
#{err} +
+ #{err} $if formHasRequiredFields
diff --git a/templates/widgets/campus-login/campus-login.hamlet b/templates/widgets/campus-login/campus-login.hamlet index 491490589..dea317b79 100644 --- a/templates/widgets/campus-login/campus-login.hamlet +++ b/templates/widgets/campus-login/campus-login.hamlet @@ -2,10 +2,10 @@ diff --git a/templates/widgets/massinput/examCorrectors/add.hamlet b/templates/widgets/massinput/examCorrectors/add.hamlet index bdf6da247..7a95b3019 100644 --- a/templates/widgets/massinput/examCorrectors/add.hamlet +++ b/templates/widgets/massinput/examCorrectors/add.hamlet @@ -1,6 +1,6 @@ $newline never ^{cellWdgts ! coord} ^{addWdgts ! (0, 0)} diff --git a/templates/widgets/massinput/examOfficeUsers/add.hamlet b/templates/widgets/massinput/examOfficeUsers/add.hamlet index 7986b68e3..66c989dc2 100644 --- a/templates/widgets/massinput/examOfficeUsers/add.hamlet +++ b/templates/widgets/massinput/examOfficeUsers/add.hamlet @@ -1,6 +1,6 @@ $newline never diff --git a/templates/widgets/massinput/examParts/add.hamlet b/templates/widgets/massinput/examParts/add.hamlet index 6ef4903fb..31c175949 100644 --- a/templates/widgets/massinput/examParts/add.hamlet +++ b/templates/widgets/massinput/examParts/add.hamlet @@ -1,4 +1,4 @@ $newline never ^{formWidget} ^{cellWdgts ! coord} ^{addWdgts ! (0, 0)} diff --git a/templates/widgets/massinput/examRooms/add.hamlet b/templates/widgets/massinput/examRooms/add.hamlet index 6ef4903fb..31c175949 100644 --- a/templates/widgets/massinput/examRooms/add.hamlet +++ b/templates/widgets/massinput/examRooms/add.hamlet @@ -1,4 +1,4 @@ $newline never ^{formWidget} ^{cellWdgts ! coord} ^{addWdgts ! (0, 0)} diff --git a/templates/widgets/massinput/list/cell.hamlet b/templates/widgets/massinput/list/cell.hamlet index 36caeb9ff..33341b860 100644 --- a/templates/widgets/massinput/list/cell.hamlet +++ b/templates/widgets/massinput/list/cell.hamlet @@ -1,3 +1,3 @@ $newline never #{csrf} -^{fvInput} +^{fvWidget fv} diff --git a/templates/widgets/massinput/list/layout.hamlet b/templates/widgets/massinput/list/layout.hamlet index 8d8776c62..84ce06596 100644 --- a/templates/widgets/massinput/list/layout.hamlet +++ b/templates/widgets/massinput/list/layout.hamlet @@ -5,6 +5,6 @@ $newline never
^{cellWdgts ! coord}
- ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)}
^{addWdgts ! (0, 0)} diff --git a/templates/widgets/massinput/submissionUsers/add.hamlet b/templates/widgets/massinput/submissionUsers/add.hamlet index 7986b68e3..66c989dc2 100644 --- a/templates/widgets/massinput/submissionUsers/add.hamlet +++ b/templates/widgets/massinput/submissionUsers/add.hamlet @@ -1,6 +1,6 @@ $newline never
diff --git a/templates/widgets/massinput/token-restrictions/add.hamlet b/templates/widgets/massinput/token-restrictions/add.hamlet index 1ffbf19f8..0e3901930 100644 --- a/templates/widgets/massinput/token-restrictions/add.hamlet +++ b/templates/widgets/massinput/token-restrictions/add.hamlet @@ -1,7 +1,7 @@ $newline never diff --git a/templates/widgets/massinput/uploadSpecificFiles/add.hamlet b/templates/widgets/massinput/uploadSpecificFiles/add.hamlet index 6ef4903fb..31c175949 100644 --- a/templates/widgets/massinput/uploadSpecificFiles/add.hamlet +++ b/templates/widgets/massinput/uploadSpecificFiles/add.hamlet @@ -1,4 +1,4 @@ $newline never ^{formWidget} ^{cellWdgts ! coord} ^{addWdgts ! (0, 0)} diff --git a/templates/widgets/occurrence/form/except-add.hamlet b/templates/widgets/occurrence/form/except-add.hamlet index 9ceedea5e..28ac40024 100644 --- a/templates/widgets/occurrence/form/except-add.hamlet +++ b/templates/widgets/occurrence/form/except-add.hamlet @@ -2,4 +2,4 @@ $newline never ^{cellWdgts ! coord} ^{cellWdgts ! coord}
_{MsgCampusIdent} - ^{fvInput identView} + ^{fvWidget identView}
_{MsgCampusPassword} - ^{fvInput passwordView} + ^{fvWidget passwordView}
#{csrf} - ^{fvInput addView} + ^{fvWidget addView} - ^{fvInput btn} + ^{fvWidget btn} diff --git a/templates/widgets/massinput/courses/layout.hamlet b/templates/widgets/massinput/courses/layout.hamlet index f1842a72f..9ee19e696 100644 --- a/templates/widgets/massinput/courses/layout.hamlet +++ b/templates/widgets/massinput/courses/layout.hamlet @@ -6,7 +6,7 @@ $newline never ^{cellWdgts ! coord} $maybe delButton <- delButtons !? coord - ^{fvInput delButton} + ^{fvWidget delButton} $maybe addWdgt <- addWdgts !? (0, 0)
#{csrf} - ^{fvInput addView} + ^{fvWidget addView} - ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/widgets/massinput/examCorrectors/layout.hamlet b/templates/widgets/massinput/examCorrectors/layout.hamlet index 65352dd95..1472ccc6c 100644 --- a/templates/widgets/massinput/examCorrectors/layout.hamlet +++ b/templates/widgets/massinput/examCorrectors/layout.hamlet @@ -5,7 +5,7 @@ $newline never
- ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)}
#{csrf} - ^{fvInput addView} + ^{fvWidget addView} - ^{fvInput btn} + ^{fvWidget btn} diff --git a/templates/widgets/massinput/examOfficeUsers/layout.hamlet b/templates/widgets/massinput/examOfficeUsers/layout.hamlet index f1842a72f..9ee19e696 100644 --- a/templates/widgets/massinput/examOfficeUsers/layout.hamlet +++ b/templates/widgets/massinput/examOfficeUsers/layout.hamlet @@ -6,7 +6,7 @@ $newline never ^{cellWdgts ! coord} $maybe delButton <- delButtons !? coord - ^{fvInput delButton} + ^{fvWidget delButton} $maybe addWdgt <- addWdgts !? (0, 0)
- ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/widgets/massinput/examParts/form.hamlet b/templates/widgets/massinput/examParts/form.hamlet index 5b0b0e9a1..97a62f64e 100644 --- a/templates/widgets/massinput/examParts/form.hamlet +++ b/templates/widgets/massinput/examParts/form.hamlet @@ -1,5 +1,8 @@ $newline never -#{csrf}^{fvInput epfIdView}^{fvInput epfNumberView} -^{fvInput epfNameView} -^{fvInput epfMaxPointsView} -^{fvInput epfWeightView} + + #{csrf} + ^{fvInput epfIdView} + ^{fvWidget epfNumberView} +^{fvWidget epfNameView} +^{fvWidget epfMaxPointsView} +^{fvWidget epfWeightView} diff --git a/templates/widgets/massinput/examParts/layout.hamlet b/templates/widgets/massinput/examParts/layout.hamlet index 86f968148..21bdf0feb 100644 --- a/templates/widgets/massinput/examParts/layout.hamlet +++ b/templates/widgets/massinput/examParts/layout.hamlet @@ -25,7 +25,7 @@ $newline never
- ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)}
- ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/widgets/massinput/examRooms/form.hamlet b/templates/widgets/massinput/examRooms/form.hamlet index 4df09253e..363566059 100644 --- a/templates/widgets/massinput/examRooms/form.hamlet +++ b/templates/widgets/massinput/examRooms/form.hamlet @@ -1,7 +1,7 @@ $newline never -#{csrf}^{fvInput eofIdView}^{fvInput eofNameView} -^{fvInput eofRoomView} -^{fvInput eofCapacityView} -^{fvInput eofStartView} -^{fvInput eofEndView} -^{fvInput eofDescView} +#{csrf}^{fvInput eofIdView}^{fvWidget eofNameView} +^{fvWidget eofRoomView} +^{fvWidget eofCapacityView} +^{fvWidget eofStartView} +^{fvWidget eofEndView} +^{fvWidget eofDescView} diff --git a/templates/widgets/massinput/examRooms/layout.hamlet b/templates/widgets/massinput/examRooms/layout.hamlet index 8bd82ae6e..bb7cbf94e 100644 --- a/templates/widgets/massinput/examRooms/layout.hamlet +++ b/templates/widgets/massinput/examRooms/layout.hamlet @@ -22,7 +22,7 @@ $newline never
- ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)}
#{csrf} - ^{fvInput addView} + ^{fvWidget addView} - ^{fvInput btn} + ^{fvWidget btn} diff --git a/templates/widgets/massinput/submissionUsers/layout.hamlet b/templates/widgets/massinput/submissionUsers/layout.hamlet index f1842a72f..9ee19e696 100644 --- a/templates/widgets/massinput/submissionUsers/layout.hamlet +++ b/templates/widgets/massinput/submissionUsers/layout.hamlet @@ -6,7 +6,7 @@ $newline never ^{cellWdgts ! coord} $maybe delButton <- delButtons !? coord - ^{fvInput delButton} + ^{fvWidget delButton} $maybe addWdgt <- addWdgts !? (0, 0)
#{csrf} - ^{fvInput routeView}
- ^{fvInput restrView} + ^{fvWidget routeView}
+ ^{fvWidget restrView}
- ^{fvInput btn} + ^{fvWidget btn} diff --git a/templates/widgets/massinput/token-restrictions/cell.hamlet b/templates/widgets/massinput/token-restrictions/cell.hamlet index af5b0462b..b661e0eb4 100644 --- a/templates/widgets/massinput/token-restrictions/cell.hamlet +++ b/templates/widgets/massinput/token-restrictions/cell.hamlet @@ -1,6 +1,6 @@ $newline never #{csrf} - ^{fvInput routeView}
- ^{fvInput restrView} + ^{fvWidget routeView}
+ ^{fvWidget restrView}
diff --git a/templates/widgets/massinput/token-restrictions/layout.hamlet b/templates/widgets/massinput/token-restrictions/layout.hamlet index f1842a72f..9ee19e696 100644 --- a/templates/widgets/massinput/token-restrictions/layout.hamlet +++ b/templates/widgets/massinput/token-restrictions/layout.hamlet @@ -6,7 +6,7 @@ $newline never ^{cellWdgts ! coord} $maybe delButton <- delButtons !? coord - ^{fvInput delButton} + ^{fvWidget delButton} $maybe addWdgt <- addWdgts !? (0, 0)
- ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/widgets/massinput/uploadSpecificFiles/form.hamlet b/templates/widgets/massinput/uploadSpecificFiles/form.hamlet index 46e856c46..3ae5d7f21 100644 --- a/templates/widgets/massinput/uploadSpecificFiles/form.hamlet +++ b/templates/widgets/massinput/uploadSpecificFiles/form.hamlet @@ -1,4 +1,4 @@ $newline never -#{csrf}^{fvInput labelView} -^{fvInput nameView} -^{fvInput reqView} +#{csrf}^{fvWidget labelView} +^{fvWidget nameView} +^{fvWidget reqView} diff --git a/templates/widgets/massinput/uploadSpecificFiles/layout.hamlet b/templates/widgets/massinput/uploadSpecificFiles/layout.hamlet index 15911ac06..b525b28c4 100644 --- a/templates/widgets/massinput/uploadSpecificFiles/layout.hamlet +++ b/templates/widgets/massinput/uploadSpecificFiles/layout.hamlet @@ -10,7 +10,7 @@ $newline never
- ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)}
^{addWidget} - ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/widgets/occurrence/form/except-layout.hamlet b/templates/widgets/occurrence/form/except-layout.hamlet index 357374a9f..253b9cd6e 100644 --- a/templates/widgets/occurrence/form/except-layout.hamlet +++ b/templates/widgets/occurrence/form/except-layout.hamlet @@ -5,7 +5,7 @@ $newline never
- ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)} $if null (review liveCoords lLength)
diff --git a/templates/widgets/occurrence/form/scheduled-add.hamlet b/templates/widgets/occurrence/form/scheduled-add.hamlet index 9ceedea5e..28ac40024 100644 --- a/templates/widgets/occurrence/form/scheduled-add.hamlet +++ b/templates/widgets/occurrence/form/scheduled-add.hamlet @@ -2,4 +2,4 @@ $newline never ^{addWidget} - ^{fvInput submitView} + ^{fvWidget submitView} diff --git a/templates/widgets/occurrence/form/scheduled-layout.hamlet b/templates/widgets/occurrence/form/scheduled-layout.hamlet index 53d6c7f3b..fd1c4ab3c 100644 --- a/templates/widgets/occurrence/form/scheduled-layout.hamlet +++ b/templates/widgets/occurrence/form/scheduled-layout.hamlet @@ -5,7 +5,7 @@ $newline never
- ^{fvInput (delButtons ! coord)} + ^{fvWidget (delButtons ! coord)} $if null (review liveCoords lLength)
diff --git a/templates/widgets/register-form/register-form.hamlet b/templates/widgets/register-form/register-form.hamlet index 347b94186..758122510 100644 --- a/templates/widgets/register-form/register-form.hamlet +++ b/templates/widgets/register-form/register-form.hamlet @@ -4,11 +4,11 @@ $# extra protects us against CSRF $# Maybe display textField for passcode $maybe secretView <- msecretView ^{fvLabel secretView} - ^{fvInput secretView} + ^{fvWidget secretView} $# Ask for associated primary field uf study, unless registered $maybe sfView <- msfView ^{fvLabel sfView} - ^{fvInput sfView} + ^{fvWidget sfView} $# Always display register/deregister button -^{fvInput btnView} +^{fvWidget btnView} diff --git a/templates/widgets/user-rights-form/user-rights-form.hamlet b/templates/widgets/user-rights-form/user-rights-form.hamlet index 8afec3a2e..a98bad2da 100644 --- a/templates/widgets/user-rights-form/user-rights-form.hamlet +++ b/templates/widgets/user-rights-form/user-rights-form.hamlet @@ -16,4 +16,4 @@ $newline never $forall function <- allFunctions $maybe (_, boxView) <- Map.lookup (function, sid) boxRights - ^{fvInput boxView} + ^{fvWidget boxView}