From 0ac75e0d5948cb90855d0e36ca8e99c22a0f6fcb Mon Sep 17 00:00:00 2001 From: Steffen Date: Wed, 3 Jul 2024 15:46:08 +0200 Subject: [PATCH 1/4] fix(letter): rephrase some minor letter parts --- src/Utils/Print/ExpireQualification.hs | 29 ++-- src/Utils/Print/RenewQualification.hs | 92 ++++++------ templates/letter/fraport_f_expiry.md | 146 ------------------- templates/letter/fraport_f_expiry.md.license | 3 - templates/letter/fraport_licence_expiry.md | 40 +++-- templates/letter/fraport_renewal.md | 32 ++-- 6 files changed, 95 insertions(+), 247 deletions(-) delete mode 100644 templates/letter/fraport_f_expiry.md delete mode 100644 templates/letter/fraport_f_expiry.md.license diff --git a/src/Utils/Print/ExpireQualification.hs b/src/Utils/Print/ExpireQualification.hs index 38bc535cb..87cdfc34e 100644 --- a/src/Utils/Print/ExpireQualification.hs +++ b/src/Utils/Print/ExpireQualification.hs @@ -6,7 +6,7 @@ module Utils.Print.ExpireQualification where -import Import +import Import -- import Data.Char as Char -- import qualified Data.Text as Text @@ -24,33 +24,28 @@ data LetterExpireQualification = LetterExpireQualification , leqHolderSN :: UserSurname , leqExpiry :: Maybe Day , leqId :: QualificationId - , leqName :: Text - , leqShort :: Text + , leqName :: Text + , leqShort :: Text , leqSchool :: SchoolId , leqUrl :: Maybe Text } deriving (Eq, Show) -instance MDLetter LetterExpireQualification where +instance MDLetter LetterExpireQualification where encryptPDFfor _ = NoPassword getLetterKind _ = Din5008 getLetterEnvelope _ = 'e' getMailSubject l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqShort l -{- - getTemplate LetterExpireQualification{leqShort="F"} - = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md") - getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_generic_expiry.md") --} getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_licence_expiry.md") - letterMeta LetterExpireQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = + letterMeta LetterExpireQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = let isSupervised = rcvrId /= leqHolderID (qArea, qFormal, qLicence) = qualificationText lang leqName leqShort in mkMeta $ guardMonoid isSupervised - [ toMeta "supervisor" userDisplayName + [ toMeta "supervisor" userDisplayName ] <> [ toMeta "lang" lang , toMeta "licencename" leqName @@ -59,14 +54,14 @@ instance MDLetter LetterExpireQualification where , toMeta "subject-meta" leqHolderDN , mbMeta "expiry" (format SelFormatDate <$> leqExpiry) , mbMeta "licence-url" leqUrl - , toMeta "de-opening" $ bool ("Guten Tag " <> leqHolderDN <> ",") "Sehr geehrte Damen und Herren," isSupervised - , toMeta "en-opening" $ bool ("Dear " <> leqHolderDN <> ",") "Dear supervisor," isSupervised - , toMeta "de-subject" [st|Entzug "#{leqShort}" (#{qLicence})|] - , toMeta "en-subject" [st|Revocation "#{leqShort}" (#{qLicence})|] + , toMeta "de-opening" $ bool [st|Guten Tag #{leqHolderDN},|] [st|Guten Tag #{userDisplayName},|] isSupervised + , toMeta "en-opening" $ bool [st|Dear #{leqHolderDN},|] [st|Dear #{userDisplayName},|] isSupervised + , toMeta "de-subject" [st|Entzug Fahrberechtigung „#{leqShort}“ (#{qLicence})|] + , toMeta "en-subject" [st|Revocation driving licence "#{leqShort}" (#{qLicence})|] , toMeta "qarea" qArea , toMeta "qformal" qFormal , toMeta "qlicence" qLicence - ] + ] getPJId LetterExpireQualification{..} = PrintJobIdentification @@ -78,7 +73,7 @@ instance MDLetter LetterExpireQualification where , pjiCourse = Nothing , pjiQualification = Just leqId , pjiLmsUser = Nothing - , pjiFileName = "expire_" <> CI.original (unSchoolKey leqSchool) <> "-" <> leqShort <> "_" <> leqHolderSN + , pjiFileName = "expire_" <> CI.original (unSchoolKey leqSchool) <> "-" <> leqShort <> "_" <> leqHolderSN -- let nameRecipient = abbrvName <$> recipient -- nameSender = abbrvName <$> sender -- nameCourse = CI.original . courseShorthand <$> course diff --git a/src/Utils/Print/RenewQualification.hs b/src/Utils/Print/RenewQualification.hs index 749a1caa9..068cffa29 100644 --- a/src/Utils/Print/RenewQualification.hs +++ b/src/Utils/Print/RenewQualification.hs @@ -6,7 +6,7 @@ module Utils.Print.RenewQualification where -import Import +import Import import Text.Hamlet import Data.Char as Char @@ -19,46 +19,51 @@ import Utils.Print.Letters import Handler.Utils.Widgets (nameHtml) -- , nameHtml') import Handler.Utils.Qualification (computeNewValidDate) --- TODO: refactor me and turn me into a qualification property (elearningOnly) -qualificationPractical :: Text -> Bool -qualificationPractical qshort = "R" == qshort -- TODO - -defaultNotice :: Lang -> Text -> Text -> Text -> [Text] -defaultNotice l qualName qualShort newExpire - | isDe l, qualificationPractical qualShort - = [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden. - Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben. - Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}. Wir empfehlen die Schulung zeitnah durchzuführen. - Sollte bis zum Ablaufdatum das E-Learning und der Praxisteil nicht erfolgreich abgeschlossen sein oder der Test nach 5 Versuchen nicht bestanden werden, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fahrerausbildung absolviert werden.|] - , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fahrerausbildung." - ] - | isDe l - = [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden. - Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben. - Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}. Wir empfehlen die Schulung zeitnah durchzuführen. - Sollte bis zum Ablaufdatum das E-Learning nicht erfolgreich abgeschlossen sein oder der Test nach 5 Versuchen nicht bestanden werden, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fahrerausbildung absolviert werden.|] - , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fahrerausbildung." +defaultNotice :: Bool -> Lang -> Text -> Text -> Text -> [Text] +defaultNotice renewAuto l qualName qualShort newExpire + | isDe l, renewAuto + = [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden. + Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben. + Bei erfolgreichem Abschluss der Schulung verlängert sich das Ablaufdatum automatisch auf den #{newExpire}. + Wir empfehlen die Schulung zeitnah durchzuführen. + Sollte bis zum Ablaufdatum das E-Learning nicht innerhalb von 5 Versuchen erfolgreich abgeschlossen sein, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fraport Fahrerausbildung absolviert werden.|] + , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fraport Fahrerausbildung." , "(Please contact us if you prefer letters in English.)" ] - | otherwise - = [ [st|A certificate for your records can only be generated immediately after a successful test. - The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed. - Upon successful completion of the training, the expiry date will automatically be extended until #{newExpire}. We recommend completing the training as soon as possible. - The licence irrevocably expires, if the e-learning is not successfully completed by the expiry date or after 5 failed attempts. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|] + | isDe l + = [ [st|Ein Zertifikat für Ihre Unterlagen kann nur direkt nach dem erfolgreichen Test erstellt werden. + Das Zertifikat wird auf die Benutzerkennung ausgestellt. Zusammen mit diesem Schreiben können Sie Ihrem Arbeitgeber zeigen, dass Sie bestanden haben. + Wir empfehlen die Schulung zeitnah durchzuführen. + Sollte bis zum Ablaufdatum das E-Learning und der Praxisteil nicht erfolgreich abgeschlossen sein, muss zur Wiedererlangung der Fahrberechtigung „#{qualShort}“ ein Grundkurs #{qualName} bei der Fraport Fahrerausbildung absolviert werden.|] + , "Benötigen Sie die Fahrberechtigung nicht mehr, informieren Sie bitte die Fraport Fahrerausbildung." + ] + | renewAuto + = [ [st|A certificate for your records can only be generated immediately after a successful test. + The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed. + Upon successful completion of the training, the expiry date will automatically be extended until #{newExpire}. + We recommend completing the training as soon as possible. + The licence irrevocably expires, if the e-learning is not successfully completed within 5 attempts by the expiry date. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|] + , "Please inform us, if this driving licence is no longer required." + , "(Kontaktieren Sie uns bitte, um zukünftige Briefe von uns in deutscher Sprache zu erhalten.)" + ] + | otherwise + = [ [st|A certificate for your records can only be generated immediately after a successful test. + The certificate will be issued for the user login. The certificate and this letter may then prove that you have passed. + We recommend completing the training as soon as possible. + The licence irrevocably expires, if the e-learning is not successfully completed within 5 attempts by the expiry date. In this case, regaining licence "#{qualShort}" requires the completing of a normal training course #{qualName} again, as if no prior experience existed.|] , "Please inform us, if this driving licence is no longer required." , "(Kontaktieren Sie uns bitte, um zukünftige Briefe von uns in deutscher Sprache zu erhalten.)" ] - qualificationText :: Lang -> Text -> Text -> (Text, Text, Text) -- (qarea, qformal, qlicence) i.e. (Rollfeld, Rollfeldfahrberechtigung, Rollfeldführerschein) translated qualificationText l qName@(Text.stripSuffix "führerschein" -> Just qPrefix) qShort | isDe l - = (qPrefix, qPrefix <> "fahrberechtigung", qName) + = (qPrefix, [st|Fahrberechtigung „#{qShort}“|], qName) | qShort == "F" - = ("apron", "apron driving licence", "apron driving licence") + = ("apron", [st|driving licence "#{qShort}"|], "apron driving licence") | qShort == "R" - = ("maneuvering area", "maneuvering area driving licence", "maneuvering area driving licence") + = ("maneuvering area", [st|driving licence "#{qShort}"|], "maneuvering area driving licence") | otherwise = (qPrefix, qPrefix <> " driving licence", qName) qualificationText l _qName "GSS" @@ -67,7 +72,7 @@ qualificationText l _qName "GSS" | otherwise = ("Forklift", "forklift driving licence", "forklift driving licence") qualificationText _l qName qShort - = (qShort, qName, qName) + = (qShort, [st|Fahrberechtigung „#{qShort}“|], qName) data LetterRenewQualification = LetterRenewQualification @@ -82,25 +87,26 @@ data LetterRenewQualification = LetterRenewQualification , qualShort :: Text , qualSchool :: SchoolId , qualDuration :: Maybe Int + , qualRenewAuto :: Bool , isReminder :: Bool } deriving (Eq, Show) -- this datatype is specific to this letter only, and just to avoid code duplication for derived data or constants -data LetterRenewQualificationData = LetterRenewQualificationData { lmsUrl, lmsUrlLogin, lmsUrlPassword, lmsIdent :: Text } +data LetterRenewQualificationData = LetterRenewQualificationData { lmsUrl, lmsUrlLogin, lmsUrlPassword, lmsIdent :: Text } deriving (Eq, Show) letterRenewalQualificationFData :: LetterRenewQualification -> LetterRenewQualificationData letterRenewalQualificationFData LetterRenewQualification{lmsLogin, lmsPin} = LetterRenewQualificationData{..} - where + where lmsUrl = "drive.fraport.de" lmsUrlLogin = "https://" <> lmsUrl <> "/?username=" <> lmsIdent lmsUrlPassword = lmsUrlLogin <> "&password=" <> lmsPin lmsIdent = getLmsIdent lmsLogin -instance MDLetter LetterRenewQualification where +instance MDLetter LetterRenewQualification where encryptPDFfor _ = PasswordUnderling getLetterKind _ = PinLetter getLetterEnvelope l = maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l) @@ -110,22 +116,20 @@ instance MDLetter LetterRenewQualification where let LetterRenewQualificationData{..} = letterRenewalQualificationFData l in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet") - letterMeta l@LetterRenewQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = - let LetterRenewQualificationData{..} = letterRenewalQualificationFData l + letterMeta l@LetterRenewQualification{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = + let LetterRenewQualificationData{..} = letterRenewalQualificationFData l isSupervised = rcvrId /= qualHolderID newExpire = computeNewValidDate (fromMaybe 0 qualDuration) qualExpiry (qArea, qFormal, qLicence) = qualificationText lang qualName qualShort in mkMeta $ guardMonoid isSupervised [ toMeta "supervisor" userDisplayName - , toMeta "de-opening" ("Sehr geehrte Damen und Herren,"::Text) - , toMeta "en-opening" ("Dear Sir or Madam,"::Text) ] <> guardMonoid isReminder [ toMeta "reminder" ("reminder"::Text) ] <> - guardMonoid (qualificationPractical qualShort) - [ toMeta "practical" True + guardMonoid (not qualRenewAuto) + [ toMeta "practical" True -- note: definied or undefined matters, bool value is unimportant ] <> [ toMeta "lang" lang , toMeta "login" lmsIdent @@ -136,11 +140,11 @@ instance MDLetter LetterRenewQualification where , mbMeta "validduration" (show <$> qualDuration) , toMeta "url-text" lmsUrl , toMeta "url" lmsUrlPassword -- ok for PDF, since it contains the PIN already - , toMeta "notice" $ defaultNotice lang qualName qualShort $ format SelFormatDate newExpire + , toMeta "notice" $ defaultNotice qualRenewAuto lang qualName qualShort $ format SelFormatDate newExpire , toMeta "de-subject" [st|Verlängerung Fahrberechtigung „#{qualShort}“ (#{qualName})|] - , toMeta "en-subject" [st|Renewal of driving licence „#{qualShort}“ (#{qualName})|] - , toMeta "de-opening" $ bool ("Guten Tag " <> qualHolderDN <> ",") "Sehr geehrte Damen und Herren," isSupervised - , toMeta "en-opening" $ bool ("Dear " <> qualHolderDN <> ",") "Dear supervisor," isSupervised + , toMeta "en-subject" [st|Renewal of driving licence "#{qualShort}" (#{qualName})|] + , toMeta "de-opening" $ bool [st|Guten Tag #{qualHolderDN},|] [st|Guten Tag #{userDisplayName},|] isSupervised + , toMeta "en-opening" $ bool [st|Dear #{qualHolderDN},|] [st|Dear #{userDisplayName},|] isSupervised , toMeta "qarea" qArea , toMeta "qformal" qFormal , toMeta "qlicence" qLicence @@ -156,7 +160,7 @@ instance MDLetter LetterRenewQualification where , pjiCourse = Nothing , pjiQualification = Just qualId , pjiLmsUser = Just lmsLogin - , pjiFileName = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN + , pjiFileName = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN -- let nameRecipient = abbrvName <$> recipient -- nameSender = abbrvName <$> sender -- nameCourse = CI.original . courseShorthand <$> course diff --git a/templates/letter/fraport_f_expiry.md b/templates/letter/fraport_f_expiry.md deleted file mode 100644 index 925f20dba..000000000 --- a/templates/letter/fraport_f_expiry.md +++ /dev/null @@ -1,146 +0,0 @@ ---- -### Metadaten, welche hier eingestellt werden: -# Absender -author: Fraport AG - Fahrerausbildung (AVN-AR) -phone: +49 69 690-30306 -email: fahrerausbildung@fraport.de -place: Frankfurt am Main -return-address: - - 60547 Frankfurt -de-opening: Liebe Fahrberechtigungsinhaber, -en-opening: Dear driver, -de-closing: | - Mit freundlichen Grüßen, - Ihre Fraport Fahrerausbildung -en-closing: | - With kind regards, - Your Fraport Driver Training -encludes: -hyperrefoptions: hidelinks - -### Metadaten, welche automatisch ersetzt werden: -de-subject: 'Entzug "F" (Vorfeldführerschein)' -en-subject: Revocation of apron driving license -date: 11.11.1111 -lang: de-de -is-de: true -# Emfpänger -licenceholder: P. Rüfling -address: - - E. M. Pfänger - - Musterfirma GmbH - - Musterstraße 11 - - 12345 Musterstadt -... -$if(titleblock)$ -$titleblock$ - -$endif$ -$for(header-includes)$ -$header-includes$ - -$endfor$ -$for(include-before)$ -$include-before$ - -$endfor$ - -$if(is-de)$ - - -$if(supervisor)$ - leider hat **$licenceholder$** -$else$ - leider haben Sie -$endif$ -den Wissenstest im Rahmen des Recurrent Trainings Vorfeldführerschein nicht bestanden -oder die Ablauffrist nicht eingehalten. - - -Die Qualifikation „Vorfeldführerschein“ ist somit -$if(expiry)$ - seit $expiry$ -$endif$ -nicht mehr gültig. - - -$if(supervisor)$ -$if(licence-url)$ -[$licenceholder$]($licence-url$) -$else$ -$licenceholder$ -$endif$ -darf -$else$ - Sie dürfen -$endif$ -ab sofort keine Fahrzeuge mehr eigenständig auf dem Vorfeld des Frankfurter Flughafens führen. - - -Um die Fahrberechtigung wiederzuerlangen, ist die Teilnahme an einem Grundkurs Vorfeldführerschein erforderlich. - -$if(supervisor)$ -Hierfür wenden Sie sich bitte an die Fahrerausbildung der Fraport AG unter: - -Telefon - - : [$phone$](tel:$phone$) - -Email - - : [$email$](mailto:$email$) - -$else$ -Hierfür wenden Sie sich bitte an Ihren Arbeitgeber. -$endif$ - -$else$ - -we regret to inform you that -$if(supervisor)$ - **$licenceholder$** -$else$ - you -$endif$ -did not pass the required knowledge test within the allotted time -for the renewal of the apron driving licence. - - -The qualification „Vorfeldführerschein“ (apron driving lincence) is therefore invalid -$if(expiry)$ - since $expiry$. -$else$ - now. -$endif$ - -$if(supervisor)$ -$if(licence-url)$ -[$licenceholder$]($licence-url$) -$else$ -$licenceholder$ -$endif$ -$else$ - You -$endif$ -may no longer drive a vehicle on the apron of Frankfurt airport, effective immediately. - - -In order to regain this apron driving licence, a full participation in a -basic training course is required. - -$if(supervisor)$ -Please contact the Fraport driving school team, if you want to book a course: - -Phone - - : [$phone$](tel:$phone$) - -Email - - : [$email$](mailto:$email$) - -$else$ -Please contact your employer to book a course for you. -$endif$ - -$endif$ diff --git a/templates/letter/fraport_f_expiry.md.license b/templates/letter/fraport_f_expiry.md.license deleted file mode 100644 index c6e55f693..000000000 --- a/templates/letter/fraport_f_expiry.md.license +++ /dev/null @@ -1,3 +0,0 @@ -SPDX-FileCopyrightText: 2023-24 Steffen Jost - -SPDX-License-Identifier: LicenseRef-Fraport-Corporate-Design diff --git a/templates/letter/fraport_licence_expiry.md b/templates/letter/fraport_licence_expiry.md index ddfcd9262..b510e55dc 100644 --- a/templates/letter/fraport_licence_expiry.md +++ b/templates/letter/fraport_licence_expiry.md @@ -9,14 +9,16 @@ email: fahrerausbildung@fraport.de place: Frankfurt am Main return-address: - 60547 Frankfurt -de-opening: Sehr geehrte Damen und Herren, +de-opening: Guten Tag, en-opening: Dear driver, de-closing: | - Mit freundlichen Grüßen, - Fraport Fahrerausbildung + Mit freundlichen Grüßen + \vspace{2EX} + Fraport Fahrerausbildung en-closing: | - With kind regards, - Fraport Driver Training + With kind regards + \vspace{2EX} + Fraport Driver Training encludes: hyperrefoptions: hidelinks @@ -53,11 +55,11 @@ $if(supervisor)$ $else$ leider haben Sie $endif$ -den Wissenstest im Rahmen des Recurrent Trainings $qlicence$ nicht bestanden +das Recurrent Training $qlicence$ nicht bestanden oder die Ablauffrist nicht eingehalten. -**Die Qualifikation „$qformal$“ ist somit +**Die Qualifikation $qformal$ ist somit $if(expiry)$ seit $expiry$ $endif$ @@ -74,14 +76,14 @@ darf $else$ Sie dürfen $endif$ -ab sofort keine Fahrzeuge mehr eigenständig auf dem $qarea$ des Frankfurter Flughafens führen. +ab sofort keine Fahrzeuge mehr eigenständig auf dem $qarea$ des Verkehrsflughafens Frankfurt/Main führen. Um die Fahrberechtigung wiederzuerlangen, ist die Teilnahme an einem -Grundkurs $qlicence$ bei der Fahrerausbildung erforderlich. +Grundkurs $qlicence$ bei der Fraport Fahrerausbildung erforderlich. -$if(supervisor)$ -Hierfür wenden Sie sich bitte an die Fahrerausbildung der Fraport AG unter: + +Hierfür wenden Sie sich bitte an die Fraport Fahrerausbildung unter: Telefon @@ -91,9 +93,6 @@ Email : [$email$](mailto:$email$) -$else$ -Hierfür wenden Sie sich bitte an Ihren Arbeitgeber. -$endif$ $else$ @@ -103,8 +102,9 @@ $if(supervisor)$ $else$ you $endif$ -did not pass the required knowledge test within the allotted time -for the renewal of the $qlicence$. +did not pass the reccurrent training +for the renewal of the $qlicence$ +within the allotted time. **The qualification „$licencename$“ ($qformal$) is therefore invalid @@ -123,13 +123,13 @@ $endif$ $else$ You $endif$ -may no longer drive a vehicle on the $qarea$ of Frankfurt airport, effective immediately. +may no longer drive a vehicle on the $qarea$ of airport Frankfurt/Main, effective immediately. In order to regain this $qlicence$, a full participation in a basic training course is required. -$if(supervisor)$ + Please contact Fraport Driver Training, if you want to book a course: Phone @@ -140,8 +140,4 @@ Email : [$email$](mailto:$email$) -$else$ -Please contact your employer to book a course for you. -$endif$ - $endif$ diff --git a/templates/letter/fraport_renewal.md b/templates/letter/fraport_renewal.md index 7b46f6b12..6166c9e2d 100644 --- a/templates/letter/fraport_renewal.md +++ b/templates/letter/fraport_renewal.md @@ -7,14 +7,16 @@ email: fahrerausbildung@fraport.de place: Frankfurt am Main return-address: - 60547 Frankfurt -de-opening: Sehr geehrte Damen und Herren, +de-opening: Guten Tag, en-opening: Dear driver, de-closing: | - Mit freundlichen Grüßen, - Fraport Fahrerausbildung + Mit freundlichen Grüßen + \vspace{2EX} + Fraport Fahrerausbildung en-closing: | - With kind regards, - Fraport Driver Training + With kind regards + \vspace{2EX} + Fraport Driver Training encludes: hyperrefoptions: colorlinks=false @@ -22,8 +24,8 @@ hyperrefoptions: colorlinks=false de-subject: 'Verlängerung Fahrberechtigung "F" (Vorfeldführerschein)' en-subject: Renewal of apron driving license qarea: 'Vorfeld' -qformal: 'Vorfeldfahrberechtigung' -qlicence: 'Vorfeldführerschein' +qformal: 'Fahrberechtigung' +qlicence: 'Führerschein' url-text: 'drive.fraport.de' url: 'https://drive.fraport.de' date: 11.11.1111 @@ -85,8 +87,8 @@ $if(supervisor)$ Ausschließlich Sie sind berechtigt, die Benutzerdaten an den Schulungsteilnehmer auszuhändigen. $endif$ -Für die Absolvierung der Schulungsmaßnahme werden 1--2 Stunden benötigt. -Der Abschluss der Schulung wird automatisch an das System der Fahrerausbildung übermittelt. +Für die Absolvierung der Schulungsmaßnahme werden ca. 2 Stunden benötigt. +Der Abschluss der Schulung wird automatisch an das System der Fraport Fahrerausbildung übermittelt. $if(practical)$ Nach erfolgreichem Abschluss der Online-Schulung @@ -97,11 +99,11 @@ $if(practical)$ $endif$ sich von Ihrer Firma zum praktischen Teil der Schulung $if(supervisor)$ - einplanen lassen. + anmelden lassen. $else$ - einplanen. + anmelden. $endif$ - Im Rahmen der 3--4-stündigen praktischen Auffrischung erfolgen Funkübungen + Im Rahmen der ca. 4-stündigen praktischen Auffrischung erfolgen Funkübungen sowie die Durchführung einer Übungsfahrt mit Prüfungscharakter im Start-/Landebahnsystem. $endif$ @@ -124,7 +126,7 @@ $else$ $endif$ we require by **$expiry$**, that the $if(practical)$ - theorectical and paractical + theorectical and practical $endif$ airport-specific recurrent training at Fraport AG, according to European Union Regulation No. 139/2014, @@ -139,7 +141,7 @@ $if(supervisor)$ Only you are authorized to hand over the personal login data to the training participant. $endif$ -The completion of the e-learning will require abut 1--2 hours. +The completion of the e-learning will require abut ca. 2 hours. Results will be automatically transmitted to Fraport Driver Training. $if(practical)$ @@ -150,7 +152,7 @@ $if(practical)$ your company must schedule you $endif$ for the practical part of the training. - The 3--4 hour practical refresher includes radio exercises and + The ca. 4 hour practical refresher includes radio exercises and an examination-style test drive within the runway system. $endif$ From 0725a9a9088a3fe4c649209a0a2b2e5a6a330609 Mon Sep 17 00:00:00 2001 From: Steffen Date: Wed, 3 Jul 2024 15:47:23 +0200 Subject: [PATCH 2/4] chore(lms): towards #169 option to prevent qualifications to renew automatically upon e-learning --- .../categories/qualification/de-de-formal.msg | 11 +++-- .../categories/qualification/en-eu.msg | 5 ++- models/lms.model | 2 +- src/Handler/Admin/Test.hs | 9 +++-- src/Handler/PrintCenter.hs | 1 + src/Handler/Qualification.hs | 2 + src/Handler/Utils/Qualification.hs | 4 +- src/Jobs/Handler/LMS.hs | 2 +- .../Handler/SendNotification/Qualification.hs | 40 +++++++++---------- templates/qualification.hamlet | 7 ++++ test/Database/Fill.hs | 6 +-- 11 files changed, 54 insertions(+), 35 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 65cd221b8..bedf81517 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatis QualificationRefreshReminder: 2. Erinnerung QualificationRefreshReminderTooltip: Optionaler Zeitraum vor Ablauf zur Versendung einer zweiten Erinnerung per Brief oder Email mit identischen Zugangsdaten, sofern in diesem Zeitraum vor Ablauf noch keine Ablaufbenachrichtigung versendet wurde. QualificationElearningStart: Wird das E‑Learning automatisch gestartet? +QualificationElearningRenew: Verlängert ein erfolgreiches E‑Learning die Qualifikation automatisch um die reguläre Gültigkeitsdauer? QualificationExpiryNotification: Ungültigkeitsbenachrichtigung? QualificationExpiryNotificationTooltip: Nutzer werden benachrichtigt, wenn die Qualifikation ungültig wird, sofern der jeweilige Nutzer in seinen Benutzereinstellungen diese Art Benachrichtigung aktiviert hat. TableQualificationCountActive: Aktive @@ -47,11 +48,12 @@ QualificationExpired: Ungültig seit LmsUser: Inhaber LmsURL: Link E‑Learning TableLmsEmail: E‑Mail -TableLmsIdent: E-Learning Benutzer +TableLmsIdent: E‑Learning Benutzer TableLmsElearning: E‑Learning +TableLmsElearningRenews: Automatische Verlängerung TableLmsPin: E‑Learning Passwort -TableLmsResetPin: E-Learning Passwort zurücksetzen? -TableLmsDatePin: E-Learning Passwort erstellt +TableLmsResetPin: E‑Learning Passwort zurücksetzen? +TableLmsDatePin: E‑Learning Passwort erstellt TableLmsDate: Datum TableLmsDelete: Löschen? TableLmsStaff: Interner Mitarbeiter? @@ -89,7 +91,8 @@ LmsReportInsert: Neues LMS Ereignis LmsReportUpdate: LMS Ereignis Aktualisierung LmsReportCsvExceptionDuplicatedKey: CSV-Import LmsReport fand uneindeutigen Schlüssel LmsDirectUpload: Direkter Upload für automatisierte Systeme -LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde. +LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde! +LmsErrorNoRenewElearning: Fehler: Erfoglreiches E‑Learning verlängert die Qualifikation nicht automatisch, da die Gültigkeitsdauer nicht festgelegt wurde! MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index 9cdc5ad36..f6f869fe3 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optional period before expiry to start e‑le QualificationRefreshReminder: 2. Reminder QualificationRefreshReminderTooltip: Optional period before expiry to send a second notification by post or email once more, provided that no renewal notification was sent in this period before expiry. QualificationElearningStart: Is e‑learning automatically started? +QualificationElearningRenew: Does successful e‑learning automatically extend a qualification by the default validity period? QualificationExpiryNotification: Invalidity notification? QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings. TableQualificationCountActive: Active @@ -50,6 +51,7 @@ TableLmsEmail: Email TableLmsIdent: E‑learning user TableLmsPin: E‑learning password TableLmsElearning: E‑learning +TableLmsElearningRenews: Automatic renewal TableLmsResetPin: Reset E‑learning password? TableLmsDatePin: E‑learning password created TableLmsDate: Date @@ -89,7 +91,8 @@ LmsReportInsert: New LMS event LmsReportUpdate: Update of LMS event LmsReportCsvExceptionDuplicatedKey: CSV Import LmsReport with ambiguous key LmsDirectUpload: Direct upload for automated systems -LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set. +LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set! +LmsErrorNoRenewElearning: Error: E‑learning will not automatically extend validity due to validity duration not being set! MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid diff --git a/models/lms.model b/models/lms.model index ee46b2037..9a78d2560 100644 --- a/models/lms.model +++ b/models/lms.model @@ -13,7 +13,7 @@ Qualification refreshWithin CalendarDiffDays Maybe -- notify users about renewal within this number of month/days before expiry; to be used with addGregorianDurationClip refreshReminder CalendarDiffDays Maybe -- send a second notification about renewal within this number of month/days before expiry elearningStart Bool -- automatically schedule e-refresher - -- elearningOnly Bool -- successful E-learing automatically increases validity. NO! + elearningRenews Bool default=true -- successful E-learing automatically increases validity automatically by validDuration expiryNotification Bool default=true -- should expiryNotification be generated for this qualification? avsLicence AvsLicence Maybe -- if set, valid QualificationUsers are synchronized to AVS as a driving licence sapId Text Maybe -- if set, valid QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs index a1d2f405d..6b4836105 100644 --- a/src/Handler/Admin/Test.hs +++ b/src/Handler/Admin/Test.hs @@ -229,7 +229,7 @@ postAdminTestR = do let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|] siteLayout locallyDefinedPageHeading $ do -- defaultLayout $ do - setTitle "Uni2work Admin Testpage" + setTitle "Uni2work Admin Testpage" $(i18nWidgetFile "admin-test") @@ -332,7 +332,7 @@ postAdminTestR = do getAdminTestPdfR :: Handler TypedContent getAdminTestPdfR = do - usr <- requireAuth -- to determine language and recipient for test + usr <- requireAuth -- to determine language and recipient for test qual <- fromMaybeM (addMessage Error "Keine Qualifikation in der Datenbank zur Erzeugung eines Test-PDFs gefunden." >> redirect AdminTestR) (runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand]) @@ -351,8 +351,9 @@ getAdminTestPdfR = do , qualShort = qual ^. _qualificationShorthand . _CI , qualSchool = qual ^. _qualificationSchool , qualDuration = qual ^. _qualificationValidDuration + , qualRenewAuto = qual ^. _qualificationElearningRenews , isReminder = False - } + } apcIdent <- letterApcIdent letter encRecipient now renderLetterPDF usr letter apcIdent Nothing >>= \case Left err -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err @@ -360,6 +361,6 @@ getAdminTestPdfR = do liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf encryptPDF "tomatenmarmelade" pdf >>= \case Left err -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err - Right encPdf -> do + Right encPdf -> do liftIO $ LBS.writeFile "/tmp/crypted.pdf" encPdf sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict pdf) now diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index db5eebb30..0f9ccc9d3 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -94,6 +94,7 @@ lrqf2letter LRQF{..} , qualShort = lrqfQuali ^. _qualificationShorthand . _CI , qualSchool = lrqfQuali ^. _qualificationSchool , qualDuration = lrqfQuali ^. _qualificationValidDuration + , qualRenewAuto = lrqfQuali ^. _qualificationElearningRenews , isReminder = lrqfReminder } return (fromMaybe usr rcvr, SomeLetter letter) diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index a67a35c21..2e15d90ee 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -102,6 +102,8 @@ mkQualificationAllTable isAdmin = do foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder) , sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart) $ tickmarkCell . view (resultAllQualification . _qualificationElearningStart) + , sortable (Just "qelearrenew") (i18nCell MsgTableLmsElearningRenews & cellTooltip MsgQualificationElearningRenew) + $ tickmarkCell . view (resultAllQualification . _qualificationElearningRenews) , sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip) $ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification) , sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip) diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs index 269747570..3fa9faa9c 100644 --- a/src/Handler/Utils/Qualification.hs +++ b/src/Handler/Utils/Qualification.hs @@ -189,6 +189,8 @@ renewValidQualificationUsers qid reason renewalTime uids = -- E.where_ $ (qu E.^. QualificationUserQualification E.==. E.val qid ) -- E.&&. (qu E.^. QualificationUserUser `E.in_` E.valList uids) get qid >>= \case + Just Qualification{qualificationElearningRenews=False} + | Just (Right (QualificationRenewELearningBy _)) <- reason -> return 0 Just Qualification{qualificationValidDuration=Just renewalMonths} -> do cutoff <- maybe (liftIO getCurrentTime) return renewalTime quEntsAll <- selectValidQualifications qid uids cutoff @@ -227,7 +229,7 @@ qualificationUserBlocking :: , Num n ) => QualificationId -> [UserId] -> Bool -> Maybe UTCTime -> QualificationChangeReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n qualificationUserBlocking qid uids unblock mbBlockTime (qualificationChangeReasonText -> reason) notify = do - $logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow uids, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify] + $logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify, "#Users:" <> tshow (length uids), tshow uids] -- this message can get very long on test systems authUsr <- liftHandler maybeAuthId now <- liftIO getCurrentTime let blockTime = fromMaybe now mbBlockTime diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index 63e6d454b..d38d37111 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -336,7 +336,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act -- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log -- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|]) -- END LMS WORKAROUND 2 - ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log + ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser] -- only valid qualifications are truly renewed and only if validDuration is set and elearningRenews is true; transcribes to audit log update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay] return $ Sum ok_renew in lrepQry lrFltrSuccess diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 4b84175f0..b94204ad7 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -25,7 +25,7 @@ dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> H dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = userMailT jRecipient $ do (recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,) <$> getJust jRecipient - <*> getJust nQualification + <*> getJust nQualification encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient let entRecipient = Entity jRecipient recipient @@ -43,19 +43,19 @@ dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = user dispatchNotificationQualificationExpired :: QualificationId -> UserId -> Handler () -dispatchNotificationQualificationExpired nQualification jRecipient = do +dispatchNotificationQualificationExpired nQualification jRecipient = do encRecipient :: CryptoUUIDUser <- encrypt jRecipient encRecShort <- encrypt jRecipient dbRes <- runDB $ (,,) <$> get jRecipient <*> get nQualification - <*> getBy (UniqueQualificationUser nQualification jRecipient) + <*> getBy (UniqueQualificationUser nQualification jRecipient) - case dbRes of + case dbRes of ( Just User{..}, Just Qualification{..}, Just (Entity quId QualificationUser{..})) -> do now <- liftIO getCurrentTime qub_entry <- entityVal <<$>> runDB (selectRelevantBlock now quId) - let block = filterMaybe (not . qualificationUserBlockUnblock) qub_entry + let block = filterMaybe (not . qualificationUserBlockUnblock) qub_entry urender <- getUrlRender let expDay = maybe qualificationUserValidUntil (min qualificationUserValidUntil . utctDay . qualificationUserBlockFrom) block qname = CI.original qualificationName @@ -94,30 +94,30 @@ dispatchNotificationQualificationRenewal nQualification nReminder jRecipient = d <*> get nQualification <*> getBy (UniqueQualificationUser nQualification jRecipient) <*> getBy (UniqueLmsQualificationUser nQualification jRecipient) - case query of + case query of (Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do let qname = CI.original qualificationName letter = LetterRenewQualification - { lmsLogin = lmsUserIdent - , lmsPin = lmsUserPin - , qualHolderID = jRecipient - , qualHolderDN = userDisplayName - , qualHolderSN = userSurname - , qualExpiry = qualificationUserValidUntil - , qualId = nQualification - , qualName = qname - , qualShort = CI.original qualificationShorthand - , qualSchool = qualificationSchool - , qualDuration = qualificationValidDuration - , isReminder = nReminder + { lmsLogin = lmsUserIdent + , lmsPin = lmsUserPin + , qualHolderID = jRecipient + , qualHolderDN = userDisplayName + , qualHolderSN = userSurname + , qualExpiry = qualificationUserValidUntil + , qualId = nQualification + , qualName = qname + , qualShort = CI.original qualificationShorthand + , qualSchool = qualificationSchool + , qualDuration = qualificationValidDuration + , qualRenewAuto = qualificationElearningRenews + , isReminder = nReminder } $logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname notifyOk <- sendEmailOrLetter jRecipient letter - when notifyOk $ do + when notifyOk $ do now <- liftIO getCurrentTime runDB $ update luid [ LmsUserNotified =. Just now] (_, Nothing, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: Qualification " <> tshow nQualification <> " does not exist!" (Nothing, _, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: User does not exist!" (_, _, Nothing, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: QualificationUser does not exist, i.e. user does not have this qualification!" (_, _, _, Nothing) -> $logWarnS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: LmsUser does not exist!" - \ No newline at end of file diff --git a/templates/qualification.hamlet b/templates/qualification.hamlet index 1459ebdfb..84d1547d2 100644 --- a/templates/qualification.hamlet +++ b/templates/qualification.hamlet @@ -49,6 +49,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

#{icon IconNotificationError} _{MsgLmsErrorNoRefreshElearning} + +

_{MsgQualificationElearningRenew} +
#{boolSymbol (qualificationElearningRenews quali)} + $if (qualificationElearningRenews quali) && isNothing (qualificationValidDuration quali) +

+ #{icon IconNotificationError} + _{MsgLmsErrorNoRefreshElearning}

^{qualificationTable} diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 25e7baf98..8613a76b3 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -753,9 +753,9 @@ fillDb = do let r_descr = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|] let l_descr = Just $ htmlToStoredMarkup [shamlet|

für unhabilitierte|] - qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True (Just AvsLicenceVorfeld) $ Just "F4466" - qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False (Just AvsLicenceRollfeld) $ Just "R2801" - qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing False True Nothing Nothing + qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True True (Just AvsLicenceVorfeld) $ Just "F4466" + qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False False (Just AvsLicenceRollfeld) $ Just "R2801" + qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing True False True Nothing Nothing qfjost <- insert' $ QualificationUser jost qid_f (n_day 11) (n_day $ -1) (n_day $ -22) True (n_day' $ -9) -- TODO: better dates! void . insert $ QualificationUserBlock qfjost False (n_day' $ -6) "First block" (Just svaupel) void . insert $ QualificationUserBlock qfjost True (n_day' $ -5) "Second unblock" (Just gkleen) From 073432c75b73218b08c10bc6346ebeb20ad0b026 Mon Sep 17 00:00:00 2001 From: Steffen Date: Wed, 3 Jul 2024 16:50:38 +0200 Subject: [PATCH 3/4] chore(letter): allow for more different driving licence names in letters --- src/Utils/Print/RenewQualification.hs | 35 ++++++++++++++++++--------- templates/letter/fraport_renewal.md | 2 +- 2 files changed, 25 insertions(+), 12 deletions(-) diff --git a/src/Utils/Print/RenewQualification.hs b/src/Utils/Print/RenewQualification.hs index 068cffa29..c8e935a8f 100644 --- a/src/Utils/Print/RenewQualification.hs +++ b/src/Utils/Print/RenewQualification.hs @@ -56,23 +56,36 @@ defaultNotice renewAuto l qualName qualShort newExpire , "(Kontaktieren Sie uns bitte, um zukünftige Briefe von uns in deutscher Sprache zu erhalten.)" ] +isAnyDrivingLicence :: Text -> Maybe Text +-- isAnyDrivingLicence = firstJust (Text.stripSuffix "führerschein") . Text.words . Text.replace "-" " " . Text.replace "+" "" +isAnyDrivingLicence = firstJust (Text.stripSuffix "führerschein") . Text.words . Text.map anyNonAlphaToBlank + +anyNonAlphaToBlank :: Char -> Char +anyNonAlphaToBlank c + | Char.isAlpha c + = c + | otherwise = ' ' + qualificationText :: Lang -> Text -> Text -> (Text, Text, Text) -- (qarea, qformal, qlicence) i.e. (Rollfeld, Rollfeldfahrberechtigung, Rollfeldführerschein) translated -qualificationText l qName@(Text.stripSuffix "führerschein" -> Just qPrefix) qShort - | isDe l - = (qPrefix, [st|Fahrberechtigung „#{qShort}“|], qName) - | qShort == "F" - = ("apron", [st|driving licence "#{qShort}"|], "apron driving licence") - | qShort == "R" - = ("maneuvering area", [st|driving licence "#{qShort}"|], "maneuvering area driving licence") - | otherwise - = (qPrefix, qPrefix <> " driving licence", qName) qualificationText l _qName "GSS" | isDe l = ("Gabelstapler", "Fahrberechtigung Gabelstapler", "Gabelstaplerführerschein") | otherwise - = ("Forklift", "forklift driving licence", "forklift driving licence") -qualificationText _l qName qShort + = ("forklift", "forklift driving licence", "forklift driving licence") +qualificationText l qName@(isAnyDrivingLicence -> Just qPrefix) qShort + | isDe l + = (qPrefix, [st|Fahrberechtigung „#{qShort}“|], qName) + | qShort == "F" + = ("apron", [st|driving licence "#{qShort}"|], "apron driving licence") + | Text.isPrefixOf "R" qShort + = ("maneuvering area", [st|driving licence "#{qShort}"|], "maneuvering area driving licence") + | otherwise + = (qPrefix, qPrefix <> " driving licence", qName) +qualificationText l qName qShort + | isDe l = (qShort, [st|Fahrberechtigung „#{qShort}“|], qName) + | otherwise + = (qShort, [st|driving licence "#{qShort}"|], qName) data LetterRenewQualification = LetterRenewQualification diff --git a/templates/letter/fraport_renewal.md b/templates/letter/fraport_renewal.md index 6166c9e2d..a27d3a5eb 100644 --- a/templates/letter/fraport_renewal.md +++ b/templates/letter/fraport_renewal.md @@ -128,7 +128,7 @@ we require by **$expiry$**, that the $if(practical)$ theorectical and practical $endif$ -airport-specific recurrent training at Fraport AG, +airport-specific $qarea$ recurrent training at Fraport AG, according to European Union Regulation No. 139/2014, has been completed. From feb8d92bc1a038b1e282ddbc6e8a95325331b8e2 Mon Sep 17 00:00:00 2001 From: Steffen Date: Wed, 3 Jul 2024 17:56:13 +0200 Subject: [PATCH 4/4] chore(log): add more filter options to admin problem log --- .../uniworx/categories/admin/de-de-formal.msg | 1 + messages/uniworx/categories/admin/en-eu.msg | 1 + src/Audit/Types.hs | 1 + src/Handler/Admin.hs | 12 +++++- src/Handler/Utils/Table/Columns.hs | 42 ++++++++++--------- 5 files changed, 36 insertions(+), 21 deletions(-) diff --git a/messages/uniworx/categories/admin/de-de-formal.msg b/messages/uniworx/categories/admin/de-de-formal.msg index 45403eebe..48a4d8c15 100644 --- a/messages/uniworx/categories/admin/de-de-formal.msg +++ b/messages/uniworx/categories/admin/de-de-formal.msg @@ -126,6 +126,7 @@ AdminProblemSolved: Erledigt AdminProblemSolver: Bearbeitet von AdminProblemCreated: Erkannt AdminProblemInfo: Problembeschreibung +AdminProblemInfoTooltip: Nur Teile der folgenden englische Begriffe sind derzeit möglich: new-company, supervisor-new-company, supervisor-left-company, superior-change, newly-unsupervised und unknown AdminProblemsSolved n@Int: #{pluralDEeN n "Admin Problem"} als erledigt markiert AdminProblemsReopened n@Int: #{pluralDEeN n "Admin Problem"} erneut eröffnet AdminProblemNewCompany: Neue Firma über AVS automatisch erstellt; prüfen und ggf. Standardansprechpartner eintragen diff --git a/messages/uniworx/categories/admin/en-eu.msg b/messages/uniworx/categories/admin/en-eu.msg index 58058188c..6a969d8c0 100644 --- a/messages/uniworx/categories/admin/en-eu.msg +++ b/messages/uniworx/categories/admin/en-eu.msg @@ -126,6 +126,7 @@ AdminProblemSolved: Done AdminProblemSolver: Solved by AdminProblemCreated: Recognized AdminProblemInfo: Problem +AdminProblemInfoTooltip: Only parts of the following keys currently work here: new-company, supervisor-new-company, supervisor-left-company, superior-change, newly-unsupervised und unknown AdminProblemsSolved n: #{pluralENsN n "admin problem"} marked as solved AdminProblemsReopened n: #{pluralENsN n "admin problem"} reopened AdminProblemNewCompany: New company from AVS; verify and add default supervisors diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index 57473bfbb..26213d616 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -261,6 +261,7 @@ derivePersistFieldJSON ''Transaction -- Datatype for raising admin awareness to certain problems -- Database stores generic Value in table ProblemLog, such that changes do not disturb old entries -- Note that there is no RenderMessage instance, instead see @Handler.Admin.adminProblemCell dealing with special cases instead +-- Note: Adjust MsgAdminProblemInfoTooltip as well data AdminProblem = AdminProblemNewCompany -- new company was noticed, presumably without supervisors { adminProblemCompany :: CompanyId diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index a94af84d3..e4ddc8cf1 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -339,10 +339,18 @@ mkProblemLogTable = over _1 postprocess <$> dbTable validator DBTable{..} , single ("solver", sortUserNameBareM querySolver) ] dbtFilter = mconcat - [ single ("solved" , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved))) + [ single ("user" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryUser) (E.?. UserDisplayName)) + , single ("solver" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to querySolver) (E.?. UserDisplayName)) + , single ("problem" , FilterColumn . E.mkContainsFilter $ views (to queryProblem) ((E.->>. "problem").(E.^. ProblemLogInfo))) + , single ("company" , FilterColumn . E.mkContainsFilter $ views (to queryProblem) ((E.->>. "company").(E.^. ProblemLogInfo))) + , single ("solved" , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved))) ] dbtFilterUI mPrev = mconcat - [ prismAForm (singletonFilter "solved" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAdminProblemSolved) + [ prismAForm (singletonFilter "user" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgAdminProblemUser & setTooltip MsgTableFilterCommaPlus) + , prismAForm (singletonFilter "solver" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgAdminProblemSolver & setTooltip MsgTableFilterCommaPlusShort) + , prismAForm (singletonFilter "problem" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgAdminProblemInfo & setTooltip MsgAdminProblemInfoTooltip) + , prismAForm (singletonFilter "company" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableCompanyShort) + , prismAForm (singletonFilter "solved" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAdminProblemSolved) ] acts :: Map ProblemTableAction (AForm Handler ProblemTableActionData) acts = mconcat diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index e04364f1e..a2feb123e 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -417,12 +417,16 @@ fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map F fltrUserNameUI = fltrUserNameLinkUI fltrUserNameLinkUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) -fltrUserNameLinkUI = fltrUserNameLinkHdrUI MsgTableCourseMembers +fltrUserNameLinkUI = fltrUserNameLinkHdrUI MsgTableCourseMembers fltrUserNameLinkHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) -fltrUserNameLinkHdrUI msg mPrev = +fltrUserNameLinkHdrUI msg mPrev = prismAForm (singletonFilter "user-name") mPrev $ aopt textField (fslI msg) +fltrUserDisplayNameHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) +fltrUserDisplayNameHdrUI msg mPrev = + prismAForm (singletonFilter "user-display-name") mPrev $ aopt textField (fslI msg) + fltrUserNameEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) fltrUserNameEmailUI = fltrUserNameEmailHdrUI MsgTableCourseMembers @@ -686,7 +690,7 @@ fltrRelevantStudyFeaturesTerms queryTermUser = singletonMap "features-terms" . F fltrRelevantStudyFeaturesTermsUI :: DBFilterUI fltrRelevantStudyFeaturesTermsUI = fltrStudyTermsUI - + fltrRelevantStudyFeaturesDegree :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId)) fltrRelevantStudyFeaturesDegree queryTermUser = singletonMap "features-degree" . FilterColumn $ \t criterias -> E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do @@ -705,7 +709,7 @@ fltrRelevantStudyFeaturesDegree queryTermUser = singletonMap "features-degree" . fltrRelevantStudyFeaturesDegreeUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) fltrRelevantStudyFeaturesDegreeUI mPrev = prismAForm (singletonFilter "features-degree") mPrev $ aopt textField (fslI MsgTableDegreeName) - + fltrRelevantStudyFeaturesSemester :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId)) fltrRelevantStudyFeaturesSemester queryTermUser = singletonMap "features-semester" . FilterColumn $ \t criterias -> E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do @@ -741,13 +745,13 @@ fltrQualificationHdrUI msg mPrev = prismAForm (singletonFilter "qualification" . {- -- colUserCompany :: (HandlerSite (DBCell m) ~ UniWorX, IsDBTable m c, HasEntity a User) => Colonnade Sortable a (DBCell m c) -colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu -> do +colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu -> do let uid = heu ^. hasEntity . _entityKey companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor) - let companies = intersperse (text2markup ", ") $ + let companies = intersperse (text2markup ", ") $ (\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies' icnSuper = text2markup " " <> icon IconSupervisor cell $ toWgt $ mconcat companies @@ -756,13 +760,13 @@ colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \ -- PROBLEM: how to type sqlCell compatible with dbTable that as actions, i.e. MForm instead of YesodDB? colUserCompany :: (IsDBTable (YesodDB UniWorX) c, HasEntity a User) => Colonnade Sortable a (DBCell (YesodDB UniWorX) c) colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \heu -> - let uid = heu ^. hasEntity . _entityKey in - sqlCell $ do + let uid = heu ^. hasEntity . _entityKey in + sqlCell $ do companies' <- E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor) - let companies = intersperse (text2markup ", ") $ + let companies = intersperse (text2markup ", ") $ (\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies' icnSuper = text2markup " " <> icon IconSupervisor pure $ toWgt $ mconcat companies @@ -803,12 +807,12 @@ fltrCompanyNameNr query = ("company-name-number", FilterColumn $ \needle (setFol let numCrits = setMapMaybe readMay criterias fltrCName = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyName)) needle criterias fltrCShort = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyShorthand)) needle criterias - fltrCno = mkExactFilter (query >>> (E.^. CompanyAvsId)) needle numCrits + fltrCno = mkExactFilter (query >>> (E.^. CompanyAvsId)) needle numCrits in if null numCrits then fltrCName E.||. fltrCShort - else fltrCName E.||. fltrCShort E.||. fltrCno + else fltrCName E.||. fltrCShort E.||. fltrCno ) - where + where setFoldMap :: (Text -> Set.Set Text) -> Set.Set Text -> Set.Set Text setFoldMap = foldMap @@ -825,22 +829,22 @@ fltrCompanyNameNrHdrUI msg mPrev = --------- -fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k) +fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k) => (a -> E.SqlExpr (Entity User)) -> Map k (FilterColumn t fs) fltrAVSCardNos queryUser = Map.singleton "avs-card" fch - where + where fch = FilterColumnHandler $ \case [] -> return (const E.true) cs -> do let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText cs toutsecs <- getsYesod $ preview $ _appAvsConf . _Just . _avsTimeout - maybeTimeoutHandler toutsecs (try $ queryAvsCardNos crds) >>= \case - Nothing -> addMessageI Error MsgAvsCommunicationTimeout + maybeTimeoutHandler toutsecs (try $ queryAvsCardNos crds) >>= \case + Nothing -> addMessageI Error MsgAvsCommunicationTimeout >> return (const E.false) (Just (Left err)) -> addMessage Error (someExc2Html err) >> return (const E.false) (Just (Right (null -> True))) -> return (const E.false) - (Just (Right apids)) -> return $ + (Just (Right apids)) -> return $ \(queryUser -> user) -> E.exists $ E.from $ \usrAvs -> E.where_ $ usrAvs E.^. UserAvsUser E.==. user E.^. UserId @@ -849,8 +853,8 @@ fltrAVSCardNos queryUser = Map.singleton "avs-card" fch someExc2Html (SomeException e) = text2Html $ tshow e fltrAVSCardNosUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) -fltrAVSCardNosUI mPrev = - prismAForm (singletonFilter "avs-card" ) mPrev $ +fltrAVSCardNosUI mPrev = + prismAForm (singletonFilter "avs-card" ) mPrev $ aopt textField (fslI MsgAvsCardNo & setTooltip (SomeMessages [SomeMessage MsgTableFilterComma, SomeMessage MsgAvsQueryNeeded]))