102 lines
4.3 KiB
Haskell
102 lines
4.3 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.CourseCertificate where
|
|
|
|
import Import
|
|
|
|
-- 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.Profile
|
|
-- import Handler.Utils.DateTime
|
|
import Handler.Utils.Occurrences
|
|
|
|
data LetterCourseCertificate = LetterCourseCertificate
|
|
{ ccCourseId :: CourseId
|
|
, ccCourseName :: Text
|
|
, ccCourseShorthand :: Text
|
|
, ccCourseSchool :: Text
|
|
, ccTutorialName :: Text
|
|
, ccCourseContent :: Maybe [Text]
|
|
, ccCourseBegin :: Maybe Day
|
|
, ccCourseEnd :: Maybe Day
|
|
, ccCourseLang :: Maybe Lang -- maybe fix language to fit course content language
|
|
, ccParticipant :: UserDisplayName
|
|
, ccFraNumber :: Maybe Text
|
|
, ccFraDepartment :: Maybe Text
|
|
, ccCompany :: Maybe Text
|
|
}
|
|
deriving (Eq, Show)
|
|
|
|
|
|
instance MDLetter LetterCourseCertificate where
|
|
encryptPDFfor _ = NoPassword
|
|
getLetterKind _ = Plain
|
|
getLetterEnvelope _ = 'c'
|
|
getTemplate LetterCourseCertificate{ccCourseContent = Just ccc} =
|
|
Text.replace "%%%course-content%%%" (unlines ccc) $
|
|
decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_qualification.md")
|
|
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_qualification.md")
|
|
getMailSubject l = SomeMessage . MsgCourseCertificate $ ccCourseName l
|
|
|
|
letterMeta LetterCourseCertificate{..} DateTimeFormatter{ format } lang _rcvrEnt =
|
|
mkMeta
|
|
[ toMeta "participant" ccParticipant
|
|
, toMeta "subject-meta" ccParticipant
|
|
, mbMeta "fra-number" ccFraNumber
|
|
, mbMeta "fra-department" ccFraDepartment
|
|
, mbMeta "company" ccCompany
|
|
, toMeta "course-name" ccCourseName
|
|
, mbMeta "course-content" ccCourseContent
|
|
, mbMeta "course-begin" (format SelFormatDate <$> ccCourseBegin)
|
|
, mbMeta "course-end" (format SelFormatDate <$> ccCourseEnd)
|
|
, toMeta "lang" (fromMaybe lang ccCourseLang)
|
|
]
|
|
|
|
getPJId LetterCourseCertificate{..} =
|
|
PrintJobIdentification
|
|
{ pjiName = "Certificate"
|
|
, pjiApcAcknowledge = "cc-" <> ccCourseName
|
|
, pjiRecipient = Nothing
|
|
, pjiSender = Nothing
|
|
, pjiCourse = Just ccCourseId
|
|
, pjiQualification = Nothing
|
|
, pjiLmsUser = Nothing
|
|
, pjiFileName = "cert_" <> ccCourseSchool <> "-" <> ccCourseShorthand <> "-" <> ccTutorialName
|
|
}
|
|
|
|
|
|
makeCourseCertificates :: Traversable t => Tutorial -> Maybe Lang -> t UserId -> DB (t LetterCourseCertificate)
|
|
makeCourseCertificates Tutorial{ tutorialName = CI.original -> ccTutorialName
|
|
, tutorialCourse = ccCourseId
|
|
, tutorialTime = occurrences
|
|
} ccCourseLang participants = do
|
|
Course{ courseName = CI.original -> ccCourseName
|
|
, courseShorthand = CI.original -> ccCourseShorthand
|
|
, courseSchool = CI.original . unSchoolKey -> ccCourseSchool
|
|
, courseDescription = fmap html2textlines -> ccCourseContent
|
|
, courseTerm = termId
|
|
} <- get404 ccCourseId
|
|
term <- get404 termId
|
|
let (ccCourseBegin, ccCourseEnd) = eq2nothing $ occurrencesBounds term occurrences
|
|
forM participants $ \uid -> do
|
|
User{userDisplayName=ccParticipant, userCompanyDepartment, userCompanyPersonalNumber} <- get404 uid
|
|
(ccFraNumber, ccFraDepartment, ccCompany) <-
|
|
if isJust userCompanyDepartment && validFraportPersonalNumber userCompanyPersonalNumber
|
|
then
|
|
return (userCompanyPersonalNumber, userCompanyDepartment, Nothing)
|
|
else do
|
|
usrComp <- selectFirst [UserCompanyUser ==. uid] [Desc UserCompanyId]
|
|
comp <- forM usrComp (get . userCompanyCompany . entityVal)
|
|
let res = (comp ^? _Just . _Just . _companyName . _CI) <|> userCompanyDepartment -- if there is no company, use the department as fallback, if possible
|
|
return (Nothing, Nothing, res)
|
|
return LetterCourseCertificate{..}
|