diff --git a/frontend/src/utils/inputs/inputs.scss b/frontend/src/utils/inputs/inputs.scss index 817534357..7bd86c059 100644 --- a/frontend/src/utils/inputs/inputs.scss +++ b/frontend/src/utils/inputs/inputs.scss @@ -36,11 +36,9 @@ font-size: 0.9rem; } -.form-group--required { - .form-group-label__caption::after { - content: ' *'; - color: var(--color-error); - } +.form-group--required .form-group-label__caption::after, .form-group__required-marker::before { + content: ' *'; + color: var(--color-error); } .form-group--optional { diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 3e89d21a4..e6081f4d2 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -523,6 +523,7 @@ NotificationSettings: Erwünschte Benachrichtigungen FormNotifications: Benachrichtigungen FormBehaviour: Verhalten FormCosmetics: Oberfläche +FormFieldRequiredTip: Gekennzeichnete Pflichtfelder sind immer auszufüllen ActiveAuthTags: Aktivierte Authorisierungsprädikate diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index 5987caa4f..9f6ad4964 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -32,6 +32,7 @@ dummyLogin :: ( YesodAuth site , YesodPersist site , SqlBackendCanRead (YesodPersistBackend site) , RenderMessage site FormMessage + , RenderMessage site AFormMessage , RenderMessage site DummyMessage , Button site ButtonSubmit ) => AuthPlugin site diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 9ea9d02e5..4f003471a 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -73,6 +73,7 @@ campusLogin :: forall site. ( YesodAuth site , RenderMessage site FormMessage , RenderMessage site CampusMessage + , RenderMessage site AFormMessage , Button site ButtonSubmit ) => LdapConf -> LdapPool -> AuthPlugin site campusLogin conf@LdapConf{..} pool = AuthPlugin{..} @@ -91,7 +92,7 @@ campusLogin conf@LdapConf{..} pool = AuthPlugin{..} Ldap.bind ldap ldapDn ldapPassword searchResults <- findUser conf ldap campusIdent [userPrincipalName] case searchResults of - [Ldap.SearchEntry (Ldap.Dn userDN) userAttrs] + [Ldap.SearchEntry (Ldap.Dn userDN) userAttrs] | Just [principalName] <- lookup userPrincipalName userAttrs , Right credsIdent <- Text.decodeUtf8' principalName -> Right (userDN, credsIdent) <$ Ldap.bind ldap (Ldap.Dn credsIdent) (Ldap.Password $ Text.encodeUtf8 campusPassword) diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs index a4eb42057..d6f5bf4e8 100644 --- a/src/Auth/PWHash.hs +++ b/src/Auth/PWHash.hs @@ -40,6 +40,7 @@ hashLogin :: ( YesodAuth site , SqlBackendCanRead (YesodPersistBackend site) , RenderMessage site FormMessage , RenderMessage site PWHashMessage + , RenderMessage site AFormMessage , Button site ButtonSubmit ) => PWHashAlgorithm -> AuthPlugin site hashLogin pwHashAlgo = AuthPlugin{..} diff --git a/src/Foundation.hs b/src/Foundation.hs index af6f3421d..8103ebfda 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -294,6 +294,8 @@ embedRenderMessage ''UniWorX ''SubmissionModeDescr in verbMap . splitCamel embedRenderMessage ''UniWorX ''UploadModeDescr id embedRenderMessage ''UniWorX ''SecretJSONFieldException id +embedRenderMessage ''UniWorX ''AFormMessage $ concat . drop 2 . splitCamel + newtype SheetTypeHeader = SheetTypeHeader SheetType embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>) diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs index 73c323d4d..5b0e634c5 100644 --- a/src/Handler/Exam.hs +++ b/src/Handler/Exam.hs @@ -699,7 +699,7 @@ getEShowR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html getEShowR tid ssh csh examn = do cTime <- liftIO getCurrentTime mUid <- maybeAuthId - + (Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn @@ -865,10 +865,10 @@ instance CsvColumnsExplained ExamUserTableCsv where , ('csvEUserDegree , MsgCsvColumnExamUserDegree ) , ('csvEUserSemester , MsgCsvColumnExamUserSemester ) , ('csvEUserOccurrence , MsgCsvColumnExamUserOccurrence ) - , ('csvEUserExercisePoints , MsgCsvColumnExamUserExercisePoints ) - , ('csvEUserExercisePasses , MsgCsvColumnExamUserExercisePasses ) - , ('csvEUserExercisePointsMax, MsgCsvColumnExamUserExercisePointsMax ) - , ('csvEUserExercisePassesMax, MsgCsvColumnExamUserExercisePassesMax ) + , ('csvEUserExercisePoints , MsgCsvColumnExamUserExercisePoints ) + , ('csvEUserExercisePasses , MsgCsvColumnExamUserExercisePasses ) + , ('csvEUserExercisePointsMax, MsgCsvColumnExamUserExercisePointsMax ) + , ('csvEUserExercisePassesMax, MsgCsvColumnExamUserExercisePassesMax ) ] data ExamUserAction = ExamUserDeregister @@ -923,7 +923,7 @@ postEUsersR tid ssh csh examn = do SheetGradeSummary{achievedPoints} <- examBonusAchieved uid bonus SheetGradeSummary{sumSheetsPoints} <- examBonusPossible uid bonus return $ propCell (getSum achievedPoints) (getSum sumSheetsPoints) - ] + ] dbtSorting = Map.fromList [ sortUserNameLink queryUser , sortUserSurname queryUser @@ -1032,7 +1032,7 @@ postERegisterR tid ssh csh examn = do runDB $ do deleteBy $ UniqueExamRegistration eId uid audit' $ TransactionExamDeregister (unTermKey tid) (unSchoolKey ssh) csh examn userIdent - addMessageI Success $ MsgExamDeregisteredSuccess examn + addMessageI Info $ MsgExamDeregisteredSuccess examn -- yes, it's a success message, but it should be visually different from a positive success, since most will just note the positive green color! Maybe make it even a warning?! redirect $ CExamR tid ssh csh examn EShowR invalidArgs ["Register/Deregister button required"] diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index ae9cb5325..ecbf65f1a 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -602,7 +602,7 @@ fileFieldMultiple = Field [whamlet| $newline never - |] + |] , fieldEnctype = Multipart } @@ -652,13 +652,16 @@ wrapForm' btn formWidget FormSettings{..} = do -- | Use this type to pass information to the form template data FormLayout = FormStandard | FormDBTableFilter | FormDBTablePagesize | FormDBTableCsvImport -renderAForm :: Monad m => FormLayout -> FormRender m a +data AFormMessage = MsgAFormFieldRequiredTip + +renderAForm :: (RenderMessage (HandlerSite m) AFormMessage, Monad m) => FormLayout -> FormRender m a renderAForm formLayout aform fragment = do (res, ($ []) -> fieldViews) <- aFormToForm aform - let widget = $(widgetFile "widgets/aform/aform") + let formHasRequiredFields = any fvRequired fieldViews + widget = $(widgetFile "widgets/aform/aform") return (res, widget) -renderWForm :: MonadHandler m => FormLayout -> WForm m (FormResult a) -> -- Form a -- (Synonym unavailable here) +renderWForm :: (RenderMessage (HandlerSite m) AFormMessage, MonadHandler m) => FormLayout -> WForm m (FormResult a) -> -- Form a -- (Synonym unavailable here) (Markup -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ())) renderWForm formLayout = renderAForm formLayout . wFormToAForm diff --git a/templates/widgets/aform/aform.hamlet b/templates/widgets/aform/aform.hamlet index 460ca1ba7..b51adbf2c 100644 --- a/templates/widgets/aform/aform.hamlet +++ b/templates/widgets/aform/aform.hamlet @@ -22,3 +22,7 @@ $case formLayout ^{fvInput view} $maybe err <- fvErrors view
#{err} + $if formHasRequiredFields +
+ + _{MsgAFormFieldRequiredTip}