182 lines
10 KiB
Haskell
182 lines
10 KiB
Haskell
-- SPDX-FileCopyrightText: 2023 Steffen Jost <jost@tcs.ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
|
|
|
|
module Utils.Print.RenewQualification where
|
|
|
|
import Import
|
|
import Text.Hamlet
|
|
|
|
import Data.Char as Char
|
|
import qualified Data.Text as Text
|
|
import qualified Data.CaseInsensitive as CI
|
|
|
|
import Data.FileEmbed (embedFile)
|
|
|
|
import Utils.Print.Letters
|
|
import Handler.Utils.Widgets (nameHtml) -- , nameHtml')
|
|
import Handler.Utils.Qualification (computeNewValidDate)
|
|
|
|
|
|
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.)"
|
|
]
|
|
| 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.)"
|
|
]
|
|
|
|
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 "GSS"
|
|
| isDe l
|
|
= ("Gabelstapler", "Fahrberechtigung Gabelstapler", "Gabelstaplerführerschein")
|
|
| otherwise
|
|
= ("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
|
|
{ lmsLogin :: LmsIdent
|
|
, lmsPin :: Text
|
|
, qualHolderID :: UserId
|
|
, qualHolderDN :: UserDisplayName
|
|
, qualHolderSN :: UserSurname
|
|
, qualExpiry :: Day
|
|
, qualId :: QualificationId
|
|
, qualName :: Text
|
|
, 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 }
|
|
deriving (Eq, Show)
|
|
|
|
letterRenewalQualificationFData :: LetterRenewQualification -> LetterRenewQualificationData
|
|
letterRenewalQualificationFData LetterRenewQualification{lmsLogin, lmsPin} = LetterRenewQualificationData{..}
|
|
where
|
|
lmsUrl = "drive.fraport.de"
|
|
lmsUrlLogin = "https://" <> lmsUrl <> "/?username=" <> lmsIdent
|
|
lmsUrlPassword = lmsUrlLogin <> "&password=" <> lmsPin
|
|
lmsIdent = getLmsIdent lmsLogin
|
|
|
|
|
|
instance MDLetter LetterRenewQualification where
|
|
encryptPDFfor _ = PasswordUnderling
|
|
getLetterKind _ = PinLetter
|
|
getLetterEnvelope l = maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
|
|
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
|
|
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
|
|
getMailBody l@LetterRenewQualification{..} = Just $ \DateTimeFormatter{ format } ->
|
|
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
|
|
isSupervised = rcvrId /= qualHolderID
|
|
newExpire = computeNewValidDate (fromMaybe 0 qualDuration) qualExpiry
|
|
(qArea, qFormal, qLicence) = qualificationText lang qualName qualShort
|
|
in mkMeta $
|
|
guardMonoid isSupervised
|
|
[ toMeta "supervisor" userDisplayName
|
|
] <>
|
|
guardMonoid isReminder
|
|
[ toMeta "reminder" ("reminder"::Text)
|
|
] <>
|
|
guardMonoid (not qualRenewAuto)
|
|
[ toMeta "practical" True -- note: definied or undefined matters, bool value is unimportant
|
|
] <>
|
|
[ toMeta "lang" lang
|
|
, toMeta "login" lmsIdent
|
|
, toMeta "pin" lmsPin
|
|
, toMeta "examinee" qualHolderDN
|
|
, toMeta "subject-meta" qualHolderDN
|
|
, toMeta "expiry" (format SelFormatDate qualExpiry)
|
|
, mbMeta "validduration" (show <$> qualDuration)
|
|
, toMeta "url-text" lmsUrl
|
|
, toMeta "url" lmsUrlPassword -- ok for PDF, since it contains the PIN already
|
|
, 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 [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
|
|
] -- NOTE: use [st|some simple text with interpolation|]
|
|
|
|
getPJId LetterRenewQualification{..} =
|
|
PrintJobIdentification
|
|
{ pjiName = bool "Renewal" "Renewal Reminder" isReminder
|
|
, pjiApcAcknowledge = "lms-" <> getLmsIdent lmsLogin
|
|
, pjiRecipient = Nothing -- to be filled later
|
|
, pjiSender = Nothing
|
|
, pjiAffected = Just qualHolderID
|
|
, pjiCourse = Nothing
|
|
, pjiQualification = Just qualId
|
|
, pjiLmsUser = Just lmsLogin
|
|
, pjiFileName = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN
|
|
-- let nameRecipient = abbrvName <$> recipient
|
|
-- nameSender = abbrvName <$> sender
|
|
-- nameCourse = CI.original . courseShorthand <$> course
|
|
-- nameQuali = CI.original . qualificationShorthand <$> quali
|
|
-- in .. = T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
|
|
} |