fix(i18n): i18n in various places

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

messages/dummy/de.msg

@@ -1,2 +1,3 @@
-DummyIdent: Nutzer-Kennung
+DummyIdent: Identifikation
+DummyIdentPlaceholder: Identifikation
 DummyNoFormData: Keine Formulardaten empfangen

messages/pw-hash/de.msg

@@ -1,2 +1,4 @@
 PWHashIdent: Identifikation
-PWHashPassword: Passwort
+PWHashIdentPlaceholder: Identifikation
+PWHashPassword: Passwort
+PWHashPasswordPlaceholder: Passwort

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

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)

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

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
+hashForm = wFormToAForm $ do
-  <$> areq ciField (fslpI MsgPWHashIdent "Identifikation") Nothing
+  mr <- getMessageRender
-  <*> areq passwordField (fslpI MsgPWHashPassword "Passwort") Nothing
+  aFormToWForm $ HashLogin
+    <$> areq ciField (fslpI MsgPWHashIdent (mr MsgPWHashIdentPlaceholder)) Nothing
+    <*> areq passwordField (fslpI MsgPWHashPassword (mr MsgPWHashPasswordPlaceholder)) Nothing
 
 
 hashLogin :: forall site.

src/Handler/Admin.hs

@@ -33,10 +33,7 @@ getAdminR :: Handler Html
 getAdminR = -- do
    siteLayoutMsg MsgAdminHeading $ do
       setTitleI MsgAdminHeading
-      [whamlet|
+      i18n MsgAdminPageEmpty
-        This shall become the Administrators' overview page.
-        Its current purpose is to provide links to some important admin functions
-      |]
 
 -- 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)
 

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

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

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")
+        <*> areq (natFieldI MsgFavouritesNotNatural)
-            (fslpI MsgFavourites "Anzahl Favoriten" & setTooltip MsgFavouritesTip) (stgMaxFavourites <$> template)
+            (fslpI MsgFavourites (mr MsgFavouritesPlaceholder) & setTooltip MsgFavouritesTip) (stgMaxFavourites <$> template)
-        <*> areq (natFieldI $ MsgNatField "Favoriten-Semester")
+        <*> areq (natFieldI MsgFavouritesSemestersNotNatural)
-            (fslpI MsgFavouriteSemesters "Anzahl Semester") (stgMaxFavouriteTerms <$> template)
+            (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

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
 

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 (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageDefaultLanguage)
-          <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") (Just systemMessageContent)
+          <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") (Just systemMessageContent)
-          <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") (Just systemMessageSummary)
+          <*> 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 (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageTranslationLanguage)
-                  <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") (Just systemMessageTranslationContent)
+                  <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") (Just systemMessageTranslationContent)
-                  <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") (Just systemMessageTranslationSummary)
+                  <*> 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 (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) Nothing
-          <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") Nothing
+          <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") Nothing
-          <*> aopt htmlField' (fslpI MsgSystemMessageSummary "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 (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just $ NonEmpty.head appLanguages)
-    <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") Nothing
+    <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") Nothing
-    <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") Nothing
+    <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") Nothing
 
   case addRes of
     FormMissing -> return ()

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 :: (MonadHandler m, HandlerSite m ~ UniWorX)
-validateTerm Term{..} =
+             => FormValidator Term m ()
-  [ msg  | (False, msg) <-
+validateTerm = do
-    [ --startOk
+  Term{..} <- State.get
-      ( termStart `withinTerm` termName
+  guardValidation MsgTermStartMustMatchName $ termStart `withinTerm` termName
-      , "Jahreszahl im Namenskürzel stimmt nicht mit Semesterbeginn überein."
+  guardValidation MsgTermEndMustBeAfterStart $ termStart < termEnd
-      )
+  guardValidation MsgTermLectureEndMustBeAfterStart $ termLectureStart < termLectureEnd
-    , -- endOk
+  guardValidation MsgTermStartMustBeBeforeLectureStart $ termStart <= termLectureStart
-      ( termStart < termEnd
+  guardValidation MsgTermEndMustBeAfterLectureEnd $ termEnd >= termLectureEnd
-      , "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."
-      )
-  ] ]
-
-
 
 
 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|
-                  <div class="alert alert-danger">
-                    <div class="alert__content">
-                      <h4> Fehler:
-                      <ul>
-                        $forall errmsg <- errorMsgs
-                          <li> #{errmsg}
-                  ^{widget}
-                |]
-              )
-      _ -> (result, widget)
-{-
-  where
-    set :: Text -> FieldSettings site
-    set = bfs
--}

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
+minIntFieldI :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage, RenderMessage (HandlerSite m) msg) => i -> msg -> Field m i
-minIntField m d = checkBool (> m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) $ intMinField m
+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
+    -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any words
-    --fieldTimeFormat = "%e.%m.%y %k:%M"
-    fieldTimeFormat = "%Y-%m-%dT%H:%M:%S"
-
-    -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any
     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