diff --git a/messages/campus/de.msg b/messages/campus/de.msg index 9a4b384fc..43d544af9 100644 --- a/messages/campus/de.msg +++ b/messages/campus/de.msg @@ -1,5 +1,6 @@ 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 diff --git a/messages/dummy/de.msg b/messages/dummy/de.msg index 5a24922aa..16bd26af5 100644 --- a/messages/dummy/de.msg +++ b/messages/dummy/de.msg @@ -1,2 +1,3 @@ -DummyIdent: Nutzer-Kennung +DummyIdent: Identifikation +DummyIdentPlaceholder: Identifikation DummyNoFormData: Keine Formulardaten empfangen \ No newline at end of file diff --git a/messages/pw-hash/de.msg b/messages/pw-hash/de.msg index 9fb1eb5e4..6a172120b 100644 --- a/messages/pw-hash/de.msg +++ b/messages/pw-hash/de.msg @@ -1,2 +1,4 @@ PWHashIdent: Identifikation -PWHashPassword: Passwort \ No newline at end of file +PWHashIdentPlaceholder: Identifikation +PWHashPassword: Passwort +PWHashPasswordPlaceholder: Passwort \ No newline at end of file diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 1ca265cc8..1b164cc8d 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -274,6 +274,8 @@ SheetSubmissionMode: Abgabe-Modus SheetExercise: Aufgabenstellung SheetHint: Hinweis SheetHintFrom: Hinweis ab +SheetHintFromPlaceholder: Datum, sonst nur für Korrektoren +SheetSolutionFromPlaceholder: Datum, sonst nur für Korrektoren SheetSolution: Lösung SheetSolutionFrom: Lösung ab SheetMarking: Hinweise für Korrektoren @@ -2060,4 +2062,29 @@ ProfileSubmissions: Abgaben ProfileRemark: Hinweis ProfileGroupSubmissionDates: Bei Gruppenabgaben wird kein Datum angezeigt, wenn Sie die Gruppenabgabe nie selbst hochgeladen haben. ProfileCorrectorRemark: Die oberhalb angezeigte Tabelle zeigt nur prinzipielle Einteilungen als Korrektor zu einem Übungsblatt. Auch ohne Einteilung können Korrekturen einzeln zugewiesen werden, welche hier dann nicht aufgeführt werden. -ProfileCorrections: Auflistung aller zugewiesenen Korrekturen \ No newline at end of file +ProfileCorrections: Auflistung aller zugewiesenen Korrekturen + +GroupSizeNotNatural: „Gruppengröße“ muss eine natürliche Zahl sein +AmbiguousEmail: E-Mail Adresse nicht eindeutig +CourseDescriptionPlaceholder: Bitte mindestens die Modulbeschreibung angeben +CourseHomepageExternalPlaceholder: Optionale externe URL +PointsPlaceholder: Punktezahl +RFC1766: RFC1766-Sprachcode + +TermShort: Kürzel +TermCourseCount: Kurse +TermStart: Semesteranfang +TermEnd: Semesterende +TermStartMustMatchName: Jahreszahl im Namenskürzel stimmt nicht mit Semesterbeginn überein. +TermEndMustBeAfterStart: Semester darf nicht enden, bevor es beginnt. +TermLectureEndMustBeAfterStart: Vorlesungszeit muss vor ihrem Ende anfgangen. +TermStartMustBeBeforeLectureStart: Semester muss vor der Vorlesungszeit beginnen. +TermEndMustBeAfterLectureEnd: Vorlesungszeit muss vor dem Semester enden. +AdminPageEmpty: Diese Seite soll eine Übersichtsseite für Administratoren werden. Aktuell finden sich hier nur Links zu wichtigen Administrator-Funktionalitäten. +HaveCorrectorAccess sheetName@SheetName: Sie haben Korrektor-Zugang zu #{original sheetName}. +FavouritesPlaceholder: Anzahl Favoriten +FavouritesNotNatural: Anzahl der Favoriten muss eine natürliche Zahl sein! +FavouritesSemestersPlaceholder: Anzahl Semester +FavouritesSemestersNotNatural: Anzahl der Favoriten-Semester muss eine natürliche Zahl sein! + +ProfileTitle: Benutzereinstellungen \ No newline at end of file diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index 4bfc09d01..9f88b5ed6 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -13,6 +13,7 @@ import qualified Data.CaseInsensitive as CI data DummyMessage = MsgDummyIdent + | MsgDummyIdentPlaceholder | MsgDummyNoFormData deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) @@ -24,7 +25,9 @@ dummyForm :: ( RenderMessage (HandlerSite m) FormMessage , Button (HandlerSite m) ButtonSubmit , MonadHandler m ) => AForm m (CI Text) -dummyForm = areq (ciField & addDatalist userList) (fslI MsgDummyIdent & noAutocomplete) Nothing +dummyForm = wFormToAForm $ do + mr <- getMessageRender + aFormToWForm $ areq (ciField & addDatalist userList) (fslpI MsgDummyIdent (mr MsgDummyIdentPlaceholder) & noAutocomplete) 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) diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 7863ec34a..e35bfce1b 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -36,6 +36,7 @@ data CampusLogin = CampusLogin data CampusMessage = MsgCampusIdentPlaceholder | MsgCampusIdent | MsgCampusPassword + | MsgCampusPasswordPlaceholder | MsgCampusSubmit | MsgCampusInvalidCredentials deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) @@ -129,7 +130,7 @@ campusForm = do MsgRenderer mr <- getMsgRenderer ident <- wreq ciField (fslpI MsgCampusIdent (mr MsgCampusIdentPlaceholder) & addAttr "autofocus" "") Nothing - password <- wreq passwordField (fslI MsgCampusPassword) Nothing + password <- wreq passwordField (fslpI MsgCampusPassword (mr MsgCampusPasswordPlaceholder)) Nothing return $ CampusLogin <$> ident diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs index b2194bf90..3fd716694 100644 --- a/src/Auth/PWHash.hs +++ b/src/Auth/PWHash.hs @@ -22,7 +22,9 @@ data HashLogin = HashLogin } deriving (Generic, Typeable) data PWHashMessage = MsgPWHashIdent + | MsgPWHashIdentPlaceholder | MsgPWHashPassword + | MsgPWHashPasswordPlaceholder deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) @@ -30,9 +32,11 @@ hashForm :: ( RenderMessage (HandlerSite m) FormMessage , RenderMessage (HandlerSite m) PWHashMessage , MonadHandler m ) => AForm m HashLogin -hashForm = HashLogin - <$> areq ciField (fslpI MsgPWHashIdent "Identifikation") Nothing - <*> areq passwordField (fslpI MsgPWHashPassword "Passwort") Nothing +hashForm = wFormToAForm $ do + mr <- getMessageRender + aFormToWForm $ HashLogin + <$> areq ciField (fslpI MsgPWHashIdent (mr MsgPWHashIdentPlaceholder)) Nothing + <*> areq passwordField (fslpI MsgPWHashPassword (mr MsgPWHashPasswordPlaceholder)) Nothing hashLogin :: forall site. diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 5bcf4359a..740609be0 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -33,10 +33,7 @@ getAdminR :: Handler Html getAdminR = -- do siteLayoutMsg MsgAdminHeading $ do setTitleI MsgAdminHeading - [whamlet| - This shall become the Administrators' overview page. - Its current purpose is to provide links to some important admin functions - |] + i18n MsgAdminPageEmpty -- BEGIN - Buttons needed only here data ButtonCreate = CreateMath | CreateInf -- Dummy for Example @@ -74,7 +71,7 @@ emailTestForm = (,) makeDemoForm :: Int -> Form (Int,Bool,Double) makeDemoForm n = identifyForm ("adminTestForm" :: Text) $ \html -> do (result, widget) <- flip (renderAForm FormStandard) html $ (,,) - <$> areq (minIntField n "Zahl") (fromString $ "Ganzzahl > " ++ show n) Nothing + <$> areq (minIntFieldI n ("Zahl" :: Text)) (fromString $ "Ganzzahl > " ++ show n) Nothing <* aformSection MsgFormBehaviour <*> areq checkBoxField "Muss nächste Zahl größer sein?" (Just True) <*> areq doubleField "Fliesskommazahl" Nothing @@ -254,8 +251,9 @@ postAdminTestR = do getAdminErrMsgR, postAdminErrMsgR :: Handler Html getAdminErrMsgR = postAdminErrMsgR postAdminErrMsgR = do + MsgRenderer mr <- getMsgRenderer ((ctResult, ctView), ctEncoding) <- runFormPost . renderAForm FormStandard $ - unTextarea <$> areq textareaField (fslpI MsgErrMsgCiphertext "Ciphertext") Nothing + unTextarea <$> areq textareaField (fslpI MsgErrMsgCiphertext (mr MsgErrMsgCiphertext)) Nothing plaintext <- formResultMaybe ctResult $ exceptT (\err -> Nothing <$ addMessageI Error err) (return . Just) . (encodedSecretBoxOpen :: Text -> ExceptT EncodedSecretBoxException Handler Value) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 9b3937a5d..b9e16b4bb 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -714,13 +714,14 @@ postCorrectionR tid ssh csh shn cid = do results <- runDB $ correctionData tid ssh csh shn sub + MsgRenderer mr <- getMsgRenderer case results of [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ subm@Submission{..}, corrector)] -> do let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c)) pointsForm = case sheetType of NotGraded -> pure Nothing _otherwise -> aopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) - (fslpI MsgRatingPoints "Punktezahl" & setTooltip sheetType) + (fslpI MsgRatingPoints (mr MsgPointsPlaceholder) & setTooltip sheetType) (Just submissionRatingPoints) ((corrResult, corrForm'), corrEncoding) <- runFormPost . identifyForm FIDcorrection . renderAForm FormStandard $ (,,) @@ -776,7 +777,6 @@ postCorrectionR tid ssh csh shn cid = do addMessageI Success MsgRatingFilesUpdated redirect $ CSubmissionR tid ssh csh shn cid CorrectionR - mr <- getMessageRender let sheetTypeDesc = mr sheetType heading = MsgCorrectionHead tid ssh csh shn cid headingWgt = [whamlet| @@ -868,9 +868,10 @@ postCorrectionsCreateR = do , optionInternalValue = sid , optionExternalValue = toPathPiece (cID :: CryptoUUIDSheet) } + MsgRenderer mr <- getMsgRenderer ((pseudonymRes, pseudonymWidget), pseudonymEncoding) <- runFormPost . renderAForm FormStandard $ (,) <$> areq (selectField sheetOptions) (fslI MsgPseudonymSheet) Nothing - <*> (textToList <$> areq textareaField (fslpI MsgCorrectionPseudonyms "Pseudonyme" & setTooltip MsgCorrectionPseudonymsTip) Nothing) + <*> (textToList <$> areq textareaField (fslpI MsgCorrectionPseudonyms (mr MsgPseudonyms) & setTooltip MsgCorrectionPseudonymsTip) Nothing) case pseudonymRes of FormMissing -> return () diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index 81dbe8573..b8fcf5748 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -256,7 +256,6 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB optionalActionW' (bool mforcedJust mpopt mayChange) allocationForm' (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseAllocationParticipateTip) (is _Just . cfAllocation <$> template) - -- TODO: internationalization -- let autoUnzipInfo = [|Entpackt hochgeladene Zip-Dateien (*.zip) automatisch und fügt den Inhalt dem Stamm-Verzeichnis der Abgabe hinzu. TODO|] (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm @@ -267,9 +266,9 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB & setTooltip MsgCourseShorthandUnique) (cfShort <$> template) <*> areq (schoolFieldFor userSchools) (fslI MsgCourseSchool) (cfSchool <$> template) <*> areq termsField (fslI MsgCourseSemester) (cfTerm <$> template) - <*> aopt htmlField (fslpI MsgCourseDescription "Bitte mindestens die Modulbeschreibung angeben" + <*> aopt htmlField (fslpI MsgCourseDescription (mr MsgCourseDescriptionPlaceholder) & setTooltip MsgCourseDescriptionTip) (cfDesc <$> template) - <*> aopt (urlField & cfStrip) (fslpI MsgCourseHomepageExternal "Optionale externe URL") + <*> aopt (urlField & cfStrip) (fslpI MsgCourseHomepageExternal (mr MsgCourseHomepageExternalPlaceholder)) (cfLink <$> template) <*> apopt checkBoxField (fslI MsgMaterialFree) (cfMatFree <$> template) <* aformSection MsgCourseFormSectionRegistration diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 170ce5dc4..b68c93006 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -79,15 +79,16 @@ instance RenderMessage UniWorX NotificationTriggerKind where makeSettingForm :: Maybe SettingsForm -> Form SettingsForm makeSettingForm template html = do + MsgRenderer mr <- getMsgRenderer (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm <$ aformSection MsgFormPersonalAppearance <*> areq (textField & cfStrip) (fslI MsgUserDisplayName & setTooltip MsgUserDisplayNameRulesBelow) (stgDisplayName <$> template) <*> areq (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail & setTooltip MsgUserDisplayEmailTip) (stgDisplayEmail <$> template) <* aformSection MsgFormCosmetics - <*> areq (natFieldI $ MsgNatField "Favoriten") - (fslpI MsgFavourites "Anzahl Favoriten" & setTooltip MsgFavouritesTip) (stgMaxFavourites <$> template) - <*> areq (natFieldI $ MsgNatField "Favoriten-Semester") - (fslpI MsgFavouriteSemesters "Anzahl Semester") (stgMaxFavouriteTerms <$> template) + <*> areq (natFieldI MsgFavouritesNotNatural) + (fslpI MsgFavourites (mr MsgFavouritesPlaceholder) & setTooltip MsgFavouritesTip) (stgMaxFavourites <$> template) + <*> areq (natFieldI MsgFavouritesSemestersNotNatural) + (fslpI MsgFavouriteSemesters (mr MsgFavouritesSemestersPlaceholder)) (stgMaxFavouriteTerms <$> template) <*> areq (selectField . return $ mkOptionList themeList) (fslI MsgTheme) { fsId = Just "theme-select" } (stgTheme <$> template) <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template) @@ -318,7 +319,7 @@ postProfileR = do tResetTime <- traverse (formatTime SelFormatDateTime) userTokensIssuedAfter siteLayout [whamlet|_{MsgProfileFor} ^{nameWidget userDisplayName userSurname}|] $ do - setTitle . toHtml $ "Profil " <> userIdent + setTitleI MsgProfileTitle let settingsForm = wrapForm formWidget FormSettings { formMethod = POST diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 543865af2..caca8b576 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -91,7 +91,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do oldFileIds <- (return.) <$> case msId of Nothing -> return $ partitionFileType mempty (Just sId) -> liftHandler $ runDB $ getFtIdMap sId - mr <- getMsgRenderer + mr'@(MsgRenderer mr) <- getMsgRenderer ctime <- ceilingQuarterHour <$> liftIO getCurrentTime (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName) (sfName <$> template) @@ -103,9 +103,9 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do & setTooltip MsgSheetActiveFromTip) (sfActiveFrom <$> template) <*> areq utcTimeField (fslI MsgSheetActiveTo) (sfActiveTo <$> template) - <*> aopt utcTimeField (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren" + <*> aopt utcTimeField (fslpI MsgSheetHintFrom (mr MsgSheetHintFromPlaceholder) & setTooltip MsgSheetHintFromTip) (sfHintFrom <$> template) - <*> aopt utcTimeField (fslpI MsgSheetSolutionFrom "Datum, sonst nur für Korrektoren" + <*> aopt utcTimeField (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder) & setTooltip MsgSheetSolutionFromTip) (sfSolutionFrom <$> template) <* aformSection MsgSheetFormFiles <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template) @@ -124,7 +124,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do <*> aopt htmlField (fslpI MsgSheetMarking "Html") (sfMarkingText <$> template) return $ case result of FormSuccess sheetResult - | errorMsgs <- validateSheet mr sheetResult + | errorMsgs <- validateSheet mr' sheetResult , not $ null errorMsgs -> (FormFailure errorMsgs, widget) _ -> (result, widget) @@ -923,5 +923,5 @@ postSCorrInviteR = invitationR correctorInvitationConfig getSIsCorrR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html -- NOTE: The route SIsCorrR is only used to verfify corrector access rights to given sheet! getSIsCorrR _ _ _ shn = do - defaultLayout $ [whamlet|You have corrector access to #{shn}.|] + defaultLayout . i18n $ MsgHaveCorrectorAccess shn diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs index c6a3c2214..3ae62b70f 100644 --- a/src/Handler/SystemMessage.hs +++ b/src/Handler/SystemMessage.hs @@ -23,6 +23,7 @@ postMessageR cID = do Nothing -> (systemMessageSummary, systemMessageContent) Just SystemMessageTranslation{..} -> (systemMessageTranslationSummary, systemMessageTranslationContent) + MsgRenderer mr <- getMsgRenderer let mkForm = do ((modifyRes, modifyView), modifyEnctype) <- runFormPost . identifyForm FIDSystemMessageModify . renderAForm FormStandard @@ -31,9 +32,9 @@ postMessageR cID = do <*> aopt utcTimeField (fslI MsgSystemMessageTo) (Just systemMessageTo) <*> areq checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) (Just systemMessageAuthenticatedOnly) <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) (Just systemMessageSeverity) - <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just systemMessageDefaultLanguage) - <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") (Just systemMessageContent) - <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") (Just systemMessageSummary) + <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageDefaultLanguage) + <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") (Just systemMessageContent) + <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") (Just systemMessageSummary) ts <- runDB $ selectList [ SystemMessageTranslationMessage ==. smId ] [Asc SystemMessageTranslationLanguage] let ts' = Map.fromList $ (systemMessageTranslationLanguage . entityVal &&& id) <$> ts @@ -45,9 +46,9 @@ postMessageR cID = do <$> fmap (Entity tId) ( SystemMessageTranslation <$> pure systemMessageTranslationMessage - <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just systemMessageTranslationLanguage) - <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") (Just systemMessageTranslationContent) - <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") (Just systemMessageTranslationSummary) + <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageTranslationLanguage) + <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") (Just systemMessageTranslationContent) + <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") (Just systemMessageTranslationSummary) ) <*> combinedButtonFieldF "" @@ -56,9 +57,9 @@ postMessageR cID = do ((addTransRes, addTransView), addTransEnctype) <- runFormPost . identifyForm FIDSystemMessageAddTranslation . renderAForm FormStandard $ SystemMessageTranslation <$> pure smId - <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") Nothing - <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") Nothing - <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") Nothing + <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) Nothing + <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") Nothing + <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") Nothing formResult modifyRes $ modifySystemMessage smId @@ -252,14 +253,15 @@ postMessageListR = do FormSuccess (_, _selection) -- prop> null _selection -> addMessageI Error MsgSystemMessageEmptySelection + MsgRenderer mr <- getMsgRenderer ((addRes, addView), addEncoding) <- runFormPost . identifyForm FIDSystemMessageAdd . renderAForm FormStandard $ SystemMessage <$> aopt utcTimeField (fslI MsgSystemMessageFrom) Nothing <*> aopt utcTimeField (fslI MsgSystemMessageTo) Nothing <*> areq checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) Nothing <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) Nothing - <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just $ NonEmpty.head appLanguages) - <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") Nothing - <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") Nothing + <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just $ NonEmpty.head appLanguages) + <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") Nothing + <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") Nothing case addRes of FormMissing -> return () diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 26c349c83..abce61c63 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -7,6 +7,8 @@ import qualified Data.Map as Map import qualified Database.Esqueleto as E import qualified Data.Set as Set + +import qualified Control.Monad.State.Class as State -- | Default start day of term for season, @@ -18,32 +20,15 @@ defaultDay True Summer = fromGregorian 2020 4 1 defaultDay False Summer = fromGregorian 2020 9 30 -validateTerm :: Term -> [Text] -validateTerm Term{..} = - [ msg | (False, msg) <- - [ --startOk - ( termStart `withinTerm` termName - , "Jahreszahl im Namenskürzel stimmt nicht mit Semesterbeginn überein." - ) - , -- endOk - ( termStart < termEnd - , "Semester darf nicht enden, bevor es begann." - ) - , -- startOk - ( termLectureStart < termLectureEnd - , "Vorlesungszeit muss vor ihrem Ende anfgangen." - ) - , -- lecStartOk - ( termStart <= termLectureStart - , "Semester muss vor der Vorlesungszeit beginnen." - ) - , -- lecEndOk - ( termEnd >= termLectureEnd - , "Vorlesungszeit muss vor dem Semester enden." - ) - ] ] - - +validateTerm :: (MonadHandler m, HandlerSite m ~ UniWorX) + => FormValidator Term m () +validateTerm = do + Term{..} <- State.get + guardValidation MsgTermStartMustMatchName $ termStart `withinTerm` termName + guardValidation MsgTermEndMustBeAfterStart $ termStart < termEnd + guardValidation MsgTermLectureEndMustBeAfterStart $ termLectureStart < termLectureEnd + guardValidation MsgTermStartMustBeBeforeLectureStart $ termStart <= termLectureStart + guardValidation MsgTermEndMustBeAfterLectureEnd $ termEnd >= termLectureEnd getTermShowR :: Handler TypedContent @@ -66,22 +51,22 @@ getTermShowR = do provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData) provideRep $ do let colonnadeTerms = widgetColonnade $ mconcat - [ sortable (Just "term-id") "Kürzel" $ \(Entity tid _, _) -> anchorCell + [ sortable (Just "term-id") (i18nCell MsgTermShort) $ \(Entity tid _, _) -> anchorCell (TermCourseListR tid) [whamlet|#{toPathPiece tid}|] , sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_) -> cell $ formatTime SelFormatDate termLectureStart >>= toWidget - , sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) -> + , sortable (Just "lecture-end") (i18nCell MsgTermLectureEnd) $ \(Entity _ Term{..},_) -> cell $ formatTime SelFormatDate termLectureEnd >>= toWidget - , sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) -> + , sortable Nothing (i18nCell MsgTermActive) $ \(Entity _ Term{..},_) -> tickmarkCell termActive - , sortable Nothing "Kurse" $ \(_, E.Value numCourses) -> + , sortable Nothing (i18nCell MsgTermCourseCount) $ \(_, E.Value numCourses) -> cell [whamlet|_{MsgNumCourses numCourses}|] - , sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) -> + , sortable (Just "start") (i18nCell MsgTermStart) $ \(Entity _ Term{..},_) -> cell $ formatTime SelFormatDate termStart >>= toWidget - , sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) -> + , sortable (Just "end") (i18nCell MsgTermEnd) $ \(Entity _ Term{..},_) -> cell $ formatTime SelFormatDate termEnd >>= toWidget - , sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) -> + , sortable Nothing (i18nCell MsgTermHolidays) $ \(Entity _ Term{..},_) -> cell $ do termHolidays' <- mapM (formatTime SelFormatDate) termHolidays [whamlet| @@ -248,7 +233,7 @@ termToTemplate (Just Term{..}) = TermFormTemplate } newTermForm :: TermFormTemplate -> Form Term -newTermForm template html = do +newTermForm template = validateForm validateTerm $ \html -> do mr <- getMessageRender let tidForm @@ -264,7 +249,7 @@ newTermForm template html = do (fslI MsgTermHolidays & setTooltip MsgMassInputTip) True (tftHolidays template) - (result, widget) <- flip (renderAForm FormStandard) html $ Term + flip (renderAForm FormStandard) html $ Term <$> tidForm <*> areq dayField (fslI MsgTermStartDay & setTooltip MsgTermStartDayTooltip) (tftStart template) <*> areq dayField (fslI MsgTermEndDay & setTooltip MsgTermEndDayTooltip) (tftEnd template) @@ -272,24 +257,3 @@ newTermForm template html = do <*> areq dayField (fslI MsgTermLectureStart) (tftLectureStart template) <*> areq dayField (fslI MsgTermLectureEnd & setTooltip MsgTermLectureEndTooltip) (tftLectureEnd template) <*> areq checkBoxField (fslI MsgTermActive) (tftActive template) - return $ case result of - FormSuccess termResult - | errorMsgs <- validateTerm termResult - , not $ null errorMsgs -> - (FormFailure errorMsgs, - [whamlet| -
-
-

Fehler: -
    - $forall errmsg <- errorMsgs -
  • #{errmsg} - ^{widget} - |] - ) - _ -> (result, widget) -{- - where - set :: Text -> FieldSettings site - set = bfs --} diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 73bcdb18e..c94045265 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -284,21 +284,12 @@ htmlField' = htmlField natFieldI :: (Monad m, Integral i, RenderMessage (HandlerSite m) msg, RenderMessage (HandlerSite m) FormMessage) => msg -> Field m i natFieldI msg = convertField fromInteger toInteger $ checkBool (>= 0) msg $ intMinField 0 -natField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i -natField d = convertField fromInteger toInteger $ checkBool (>= 0) (T.append d " muss eine natürliche Zahl sein.") $ intMinField 0 - -natIntField ::(Monad m, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m Integer -natIntField = natField - -posIntField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i -posIntField d = convertField fromInteger toInteger $ checkBool (> 0) (T.append d " muss eine positive Zahl sein.") $ intMinField 1 - posIntFieldI :: (Monad m, Integral i, RenderMessage (HandlerSite m) msg, RenderMessage (HandlerSite m) FormMessage) => msg -> Field m i posIntFieldI msg = convertField fromInteger toInteger $ checkBool (> 0) msg $ intMinField 0 -- | Field to request integral number > 'm' -minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i -minIntField m d = checkBool (> m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) $ intMinField m +minIntFieldI :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage, RenderMessage (HandlerSite m) msg) => i -> msg -> Field m i +minIntFieldI m msg = checkBool (> m) msg $ intMinField m pointsField :: (Monad m, HandlerSite m ~ UniWorX) => Field m Points pointsField = pointsFieldMinMax (Just 0) Nothing @@ -831,7 +822,7 @@ sheetGroupAFormReq fs template = multiActionA selOptions fs (classify' <$> templ where selOptions = Map.fromList [ ( Arbitrary', Arbitrary - <$> apreq (natField "Gruppengröße") (fslI MsgSheetGroupMaxGroupsize & noValidate) (preview _maxParticipants =<< template) + <$> apreq (natFieldI MsgGroupSizeNotNatural) (fslI MsgSheetGroupMaxGroupsize & noValidate) (preview _maxParticipants =<< template) ) , ( RegisteredGroups', pure RegisteredGroups ) , ( NoGroups', pure NoGroups ) @@ -861,6 +852,10 @@ dayTimeField fs mutc = do | otherwise = (Nothing,Nothing) -} +fieldTimeFormat :: String +-- fieldTimeFormat = "%e.%m.%y %k:%M" +fieldTimeFormat = "%Y-%m-%dT%H:%M:%S" + localTimeField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m LocalTime localTimeField = Field { fieldParse = parseHelperGen readTime @@ -873,11 +868,7 @@ localTimeField = Field , fieldEnctype = UrlEncoded } where - fieldTimeFormat :: String - --fieldTimeFormat = "%e.%m.%y %k:%M" - fieldTimeFormat = "%Y-%m-%dT%H:%M:%S" - - -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any + -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any words readTime :: Text -> Either UniWorXMessage LocalTime readTime t = case parseTimeM True defaultTimeLocale fieldTimeFormat (T.unpack t) of @@ -1149,7 +1140,7 @@ multiUserField onlySuggested suggestions = Field{..} case dbRes of [] -> return $ Left email [E.Value uid] -> return $ Right uid - _other -> throwE $ SomeMessage ("Ambiguous e-mail addr" :: Text) + _other -> throwE $ SomeMessage MsgAmbiguousEmail examResultField :: forall m res. ( MonadHandler m