refactor(letter): introduce existentially quantified letter class SomeLetter

This commit is contained in:
Steffen Jost 2023-05-05 07:41:38 +00:00
parent 328ce70bd7
commit 6b5c37a97c
8 changed files with 40 additions and 19 deletions

View File

@ -2,7 +2,7 @@
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
{-# LANGUAGE TypeApplications, ExistentialQuantification #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Handler.PrintCenter
@ -25,7 +25,6 @@ import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH
import Utils.Print
import Utils.Print.Letters (MDLetter)
-- import Data.Aeson (encode)
import qualified Data.Text as Text
@ -39,7 +38,6 @@ import Handler.Utils
single :: (k,a) -> Map k a
single = uncurry Map.singleton
data SomeLetter = forall l . (MDLetter l) => SomeLetter l -- a record selector would be useless here due to the escaped type variable
data LRQF = LRQF
{ lrqfLetter :: Text
@ -313,9 +311,7 @@ postPrintSendR = do
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
let procFormSend lrqf = do
ok <- (runDB (lrqf2letter lrqf) >>= \case
(entUsr, SomeLetter l) -> printLetter (Just uid) (entUsr, l)
) >>= \case
ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case
Left err -> do
let msg = "PDF printing failed with error: " <> err
$logErrorS "LPR" msg

View File

@ -19,6 +19,7 @@ module Utils.Print
, mkMeta, appMeta, applyMetas -- multiple values
-- , MDMail
-- , MDLetter
, SomeLetter(..)
, LetterRenewQualificationF(..)
, LetterExpireQualificationF(..)
-- , LetterCourseCertificate()
@ -55,6 +56,7 @@ import Jobs.Handler.SendNotification.Utils
import Utils.Print.Instances ()
import Utils.Print.Letters
import Utils.Print.SomeLetter
import Utils.Print.RenewQualification
import Utils.Print.ExpireQualification
import Utils.Print.CourseCertificate
@ -148,7 +150,7 @@ renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
now <- liftIO getCurrentTime
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
kind = getLetterKind $ pure mdl
kind = getLetterKind mdl
tmpl = getTemplate mdl
meta = addApcIdent apcIdent
<> letterMeta mdl formatter lang rcvrEnt
@ -170,7 +172,7 @@ renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent
now <- liftIO getCurrentTime
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
kind = getLetterKind $ pure l
kind = getLetterKind l
templateCombine _ err@Left{} = pure err
templateCombine mdl (Right doc1) =
@ -286,7 +288,7 @@ sendEmailOrLetter recipient letter = do
$logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
return True
Right pdf -> do -- send email
let pdfPass = case encrypPDFfor (pure letter) of
let pdfPass = case encryptPDFfor letter of
NoPassword -> Nothing
PasswordSupervisor -> rcvrUsr ^. _userPinPassword
PasswordUnderling -> underling ^. _userPinPassword

View File

@ -36,7 +36,7 @@ data LetterCourseCertificate = LetterCourseCertificate
instance MDLetter LetterCourseCertificate where
encrypPDFfor _ = NoPassword
encryptPDFfor _ = NoPassword
getLetterKind _ = Plain
getLetterEnvelope _ = 'c'
getTemplate LetterCourseCertificate{ccCourseContent = Just ccc} =

View File

@ -48,7 +48,7 @@ instance MDMail LetterExpireQualificationF where
in $(ihamletFile "templates/mail/qualificationExpired.hamlet")
instance MDLetter LetterExpireQualificationF where
encrypPDFfor _ = NoPassword
encryptPDFfor _ = NoPassword
getLetterKind _ = Din5008
getLetterEnvelope _ = 'e'
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")

View File

@ -225,15 +225,15 @@ class MDLetter l where
-- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetter for each receiver
getPJId :: l -> PrintJobIdentification
getLetterEnvelope :: l -> Char
getLetterKind :: Proxy l -> LetterKind
getLetterKind :: l -> LetterKind
getTemplate :: l -> Text
encrypPDFfor :: Proxy l -> EncryptPDFfor
encryptPDFfor :: l -> EncryptPDFfor
letterApcIdent :: (MDLetter l, MonadHandler m) => l -> CryptoUUIDUser -> UTCTime -> m Text
letterApcIdent l uuid now = do
-- now <- liftIO getCurrentTime
tnow <- formatTime' "%y%m%d-%H" now
return $ mkApcIdent uuid (getLetterEnvelope l) (getLetterKind $ pure l) tnow (pjiApcAcknowledge $ getPJId l)
return $ mkApcIdent uuid (getLetterEnvelope l) (getLetterKind l) tnow (pjiApcAcknowledge $ getPJId l)
letterFileName :: (MDLetter l) => l -> FilePath
letterFileName = Text.unpack . (<> ".pdf") . text2asciiAlphaNum . pjiFileName . getPJId

View File

@ -53,7 +53,7 @@ instance MDMail LetterRenewQualificationF where
in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
instance MDLetter LetterRenewQualificationF where
encrypPDFfor _ = PasswordUnderling
encryptPDFfor _ = PasswordUnderling
getLetterKind _ = PinLetter
getLetterEnvelope _ = 'f' -- maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")

View File

@ -0,0 +1,23 @@
-- SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
{-# LANGUAGE ExistentialQuantification #-}
module Utils.Print.SomeLetter where
import Utils.Print.Letters
data SomeLetter = forall l . (MDLetter l, MDMail l) => SomeLetter l -- a record selector would be useless here due to the escaped type variable
instance MDMail SomeLetter where
getMailSubject (SomeLetter l) = getMailSubject l
getMailBody (SomeLetter l) = getMailBody l
instance MDLetter SomeLetter where
letterMeta (SomeLetter l) = letterMeta l
getPJId (SomeLetter l) = getPJId l
getLetterEnvelope (SomeLetter l) = getLetterEnvelope l
getLetterKind (SomeLetter l) = getLetterKind l
getTemplate (SomeLetter l) = getTemplate l
encryptPDFfor (SomeLetter l) = encryptPDFfor l

View File

@ -50,7 +50,7 @@ $if(is-de)$
<!-- deutsche Version des Briefes -->
$if(supervisor)$
leider hat $licenceholder$
leider hat **$licenceholder$**
$else$
leider haben Sie
$endif$
@ -62,7 +62,7 @@ Die Qualifikation „Vorfeldführerschein“ ist somit nicht mehr gültig.
$if(supervisor)$
**$licenceholder$** darf
$licenceholder$ darf
$else$
Sie dürfen
$endif$
@ -94,7 +94,7 @@ $if(supervisor)$
$else$
you
$endif$
did not pass the required knowledge test within the alotted time
did not pass the required knowledge test within the allotted time
for the renewal of the apron driving licence.
@ -124,7 +124,7 @@ Email
: $email$
$else$
Please contact you employer to book a course for you.
Please contact your employer to book a course for you.
$endif$
$endif$