fix(i18n): i18n in various places
This commit is contained in:
Gregor Kleen
parent
3fe278ec30
commit
155ed1d557
@ -1,5 +1,6 @@
|
||||
CampusIdentPlaceholder: Vorname.Nachname@campus.lmu.de
|
||||
CampusIdent: Campus-Kennung
|
||||
CampusPassword: Passwort
|
||||
CampusPasswordPlaceholder: Passwort
|
||||
CampusSubmit: Abschicken
|
||||
CampusInvalidCredentials: Ungültige Logindaten
|
||||
@ -1,2 +1,3 @@
|
||||
DummyIdent: Nutzer-Kennung
|
||||
DummyIdent: Identifikation
|
||||
DummyIdentPlaceholder: Identifikation
|
||||
DummyNoFormData: Keine Formulardaten empfangen
|
||||
@ -1,2 +1,4 @@
|
||||
PWHashIdent: Identifikation
|
||||
PWHashPassword: Passwort
|
||||
PWHashIdentPlaceholder: Identifikation
|
||||
PWHashPassword: Passwort
|
||||
PWHashPasswordPlaceholder: Passwort
|
||||
@ -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
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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 ()
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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 ()
|
||||
|
||||
@ -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|
|
||||
<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
|
||||
-}
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user