106 lines
5.4 KiB
Haskell
106 lines
5.4 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')
|
|
|
|
|
|
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 _ = PinNew
|
|
getLetterEnvelope _ = 'f' -- maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
|
|
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal_new.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
|
|
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)
|
|
] <>
|
|
[ 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" [ [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 #{format SelFormatDate 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."::Text
|
|
, "(Please contact us if you prefer letters in English.)"
|
|
]
|
|
, toMeta "de-subject" [st|Verlängerung Fahrberechtigung „#{qualShort}“ (#{qualName})|]
|
|
, toMeta "en-subject" [st|Renewal of driving licence „#{qualShort}“ (#{qualName})|]
|
|
] -- TODO 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
|
|
, 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])
|
|
} |