163 lines
8.8 KiB
Haskell
163 lines
8.8 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')
|
|
|
|
-- 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."
|
|
, "(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.|]
|
|
, "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)
|
|
| qShort == "F"
|
|
= ("apron", "apron driving licence", "apron driving licence")
|
|
| qShort == "R"
|
|
= ("maneuvering area", "maneuvering area driving licence", "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
|
|
= (qShort, qName, 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
|
|
, 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, lmsIdent :: Text }
|
|
deriving (Eq, Show)
|
|
|
|
letterRenewalQualificationFData :: LetterRenewQualification -> LetterRenewQualificationData
|
|
letterRenewalQualificationFData LetterRenewQualification{lmsLogin} = LetterRenewQualificationData{..}
|
|
where
|
|
lmsUrl = "drive.fraport.de"
|
|
lmsUrlLogin = "https://" <> lmsUrl <> "/?login=" <> lmsIdent
|
|
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 = addDays (fromIntegral $ 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
|
|
] <>
|
|
[ 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" lmsUrlLogin
|
|
, toMeta "notice" $ defaultNotice 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 "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])
|
|
} |