refactor(letter): introduce existentially quantified letter class SomeLetter
This commit is contained in:
parent
328ce70bd7
commit
6b5c37a97c
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -36,7 +36,7 @@ data LetterCourseCertificate = LetterCourseCertificate
|
||||
|
||||
|
||||
instance MDLetter LetterCourseCertificate where
|
||||
encrypPDFfor _ = NoPassword
|
||||
encryptPDFfor _ = NoPassword
|
||||
getLetterKind _ = Plain
|
||||
getLetterEnvelope _ = 'c'
|
||||
getTemplate LetterCourseCertificate{ccCourseContent = Just ccc} =
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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")
|
||||
|
||||
23
src/Utils/Print/SomeLetter.hs
Normal file
23
src/Utils/Print/SomeLetter.hs
Normal 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
|
||||
@ -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$
|
||||
|
||||
Loading…
Reference in New Issue
Block a user