From 539593fe2d17707c9f82ed6fc0c6f78ba0cab018 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 8 May 2023 14:42:29 +0000 Subject: [PATCH] chore(letter): html expiry letter working --- .../uniworx/categories/print/de-de-formal.msg | 3 +- messages/uniworx/categories/print/en-eu.msg | 3 +- src/Handler/PrintCenter.hs | 38 ++- src/Utils/Print.hs | 62 +++-- src/Utils/Print/ExpireQualification.hs | 7 +- src/Utils/Print/Letters.hs | 3 + templates/letter/fraport_f_expiry.md | 17 +- templates/letter/generic_template.html | 263 +++++++++++++++++- 8 files changed, 340 insertions(+), 56 deletions(-) diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index c5a134c12..88b38730a 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/messages/uniworx/categories/print/de-de-formal.msg @@ -21,4 +21,5 @@ PrintQualification: Qualifikation PrintPDF !ident-ok: PDF PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden PrintLmsUser: E‑Learning Id -PrintJobs: Druckaufräge \ No newline at end of file +PrintJobs: Druckaufräge +PrintLetterType: Brieftypkürzel \ No newline at end of file diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index 770a23725..5cf800eb3 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/messages/uniworx/categories/print/en-eu.msg @@ -21,4 +21,5 @@ PrintQualification: Qualification PrintPDF: PDF PrintManualRenewal: Manual sending of an apron driver's licence renewal letter PrintLmsUser: E‑learning id -PrintJobs: Print jobs \ No newline at end of file +PrintJobs: Print jobs +PrintLetterType: Letter type shorthand \ No newline at end of file diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 1efb0dd4d..41fa484d3 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -53,7 +53,7 @@ makeRenewalForm :: Maybe LRQF -> Form LRQF makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRenewQualificationF $ \html -> do -- now_day <- utctDay <$> liftIO getCurrentTime flip (renderAForm FormStandard) html $ LRQF - <$> areq textField (fslI MsgLmsUser) (lrqfLetter <$> tmpl) + <$> areq textField (fslI MsgPrintLetterType) (lrqfLetter <$> tmpl) <*> areq (userField False Nothing) (fslI MsgLmsUser) (lrqfUser <$> tmpl) <*> aopt (userField False Nothing) (fslI MsgTableSupervisor) (lrqfSuper <$> tmpl) <*> areq qualificationFieldEnt (fslI MsgQualificationName) (lrqfQuali <$> tmpl) @@ -88,10 +88,11 @@ lrqf2letter LRQF{..} , qualDuration = lrqfQuali ^. _qualificationValidDuration } return (fromMaybe usr rcvr, SomeLetter letter) - | lrqfLetter == "e" = do + | lrqfLetter == "e" || lrqfLetter == "E" = do rcvr <- mapM getUser lrqfSuper usr <- getUser lrqfUser usrUuid <- encrypt $ entityKey usr + urender <- liftHandler getUrlRender let letter = LetterExpireQualificationF { leqfHolderUUID = usrUuid , leqfHolderID = usr ^. _entityKey @@ -102,6 +103,7 @@ lrqf2letter LRQF{..} , leqfName = lrqfQuali ^. _qualificationName . _CI , leqfShort = lrqfQuali ^. _qualificationShorthand . _CI , leqfSchool = lrqfQuali ^. _qualificationSchool + , leqfUrl = pure . urender $ ForProfileDataR usrUuid } return (fromMaybe usr rcvr, SomeLetter letter) | otherwise = error "Unknown Letter Type encountered. Use 'e' or 'r' only." @@ -311,18 +313,26 @@ postPrintSendR = do def_lrqf = mkLetter <$> mbQual ((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf - let procFormSend lrqf = do - ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case - Left err -> do - let msg = "PDF printing failed with error: " <> err - $logErrorS "LPR" msg - addMessage Error $ toHtml msg - pure False - Right (ok, fpath) -> do - let response = if null ok then mempty else " Response: " <> ok - addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> pack fpath <> response - pure True - when ok $ redirect PrintCenterR + let procFormSend lrqf = case lrqfLetter lrqf of + "E" -> (runDB (lrqf2letter lrqf) >>= printHtml (Just uid)) >>= \case + Right html -> sendResponse $ toTypedContent html + Left err -> do + let msg = "PDF printing failed with error: " <> err + $logErrorS "LPR" msg + addMessage Error $ toHtml msg + pure () + _ -> do + ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case + Left err -> do + let msg = "PDF printing failed with error: " <> err + $logErrorS "LPR" msg + addMessage Error $ toHtml msg + pure False + Right (ok, fpath) -> do + let response = if null ok then mempty else " Response: " <> ok + addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> pack fpath <> response + pure True + when ok $ redirect PrintCenterR formResult sendResult procFormSend -- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute siteLayoutMsg MsgPrintManualRenewal $ do diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 5b00aa3bf..4682e2296 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -9,6 +9,7 @@ module Utils.Print , renderLetters , sendEmailOrLetter -- directly print or sends by email , printLetter -- always send a letter + , printHtml -- return letter as Html only , letterApcIdent -- create acknowledge string for APC , letterFileName -- default filename , encryptPDF @@ -165,24 +166,29 @@ renderLetterPDF rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do actRight e_md $ pdfLaTeX kind --- renderLetterHtml :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text Html) --- renderLetterHtml 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 mdl --- tmpl = getTemplate mdl --- meta = addApcIdent apcIdent --- <> letterMeta mdl formatter lang rcvrEnt --- <> mkMeta --- [ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages --- toMeta "date" $ format SelFormatDate now --- , toMeta "rcvr-name" $ rcvr & userDisplayName --- , toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr --- --, toMeta "rcvr-email" $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise --- ] --- e_md <- mdTemplating tmpl meta --- actRight e_md $ pdfLaTeX kind +renderLetterHtml :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text Html) +renderLetterHtml 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 mdl + tmpl = getTemplate mdl + meta = addApcIdent apcIdent + <> letterMeta mdl formatter lang rcvrEnt + <> mkMeta + [ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages + toMeta "date" $ format SelFormatDate now + , toMeta "rcvr-name" $ rcvr & userDisplayName + , toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr + --, toMeta "rcvr-email" $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise + ] + e_md <- mdTemplating tmpl meta + actRight e_md $ \md -> pure . over _Left P.renderError . P.runPure $ do + html_tmpl <- compileTemplate $ templateHtml kind + -- html_tmpl <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("LetterKind-Html: \n" <> tshow lk) (pure . over _Left P.renderError . P.runPure $ compileTemplate $ templateHtml lk) + let writerOpts = def { P.writerExtensions = P.pandocExtensions + , P.writerTemplate = Just html_tmpl } + P.writeHtml5 writerOpts $ appMeta setIsDeFromLang md -- TODO: apcIdent does not make sense for multiple letters renderLetters :: (MDLetter l, Foldable f) => Entity User -> f l -> Text -> Handler (Either Text LBS.ByteString) @@ -220,6 +226,15 @@ renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent -- PrintJobs -- --------------- +-- Only used in print-test-handler for PrintSendR +printHtml :: (MDLetter l) => Maybe UserId -> (Entity User, l) -> Handler (Either Text Html) +printHtml _senderId (rcvr, letter) = do + let rcvrId = rcvr ^. _entityKey + encRecipient :: CryptoUUIDUser <- encrypt rcvrId + now <- liftIO getCurrentTime + apcIdent <- letterApcIdent letter encRecipient now + renderLetterHtml rcvr letter apcIdent + -- Only used in print-test-handler for PrintSendR printLetter :: (MDLetter l) => Maybe UserId -> (Entity User, l) -> Handler (Either Text (Text, FilePath)) printLetter senderId (rcvr, letter) = do @@ -284,7 +299,16 @@ sendEmailOrLetter recipient letter = do oks <- forM receivers $ \rcvrEnt@Entity{ entityKey = svr, entityVal = rcvrUsr } -> do encRecipient :: CryptoUUIDUser <- encrypt svr apcIdent <- letterApcIdent letter encRecipient now - let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr + -- case getPostalPreferenceAndAddress rcvrUsr of + -- (True, Nothing) -> do -- neither email nor postal is known + -- let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid + -- $logErrorS "LETTER" msg + -- return False + -- + -- (False, _) -> do -- send Email + -- if attachPDFLetter + -- + let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr -- mailBody <- getMailBody letter formatter renderLetterPDF rcvrEnt letter apcIdent >>= \case _ | preferPost, isNothing postal -> do -- neither email nor postal is known diff --git a/src/Utils/Print/ExpireQualification.hs b/src/Utils/Print/ExpireQualification.hs index d596cbc1d..fef6407e4 100644 --- a/src/Utils/Print/ExpireQualification.hs +++ b/src/Utils/Print/ExpireQualification.hs @@ -28,7 +28,8 @@ data LetterExpireQualificationF = LetterExpireQualificationF , leqfId :: QualificationId , leqfName :: Text , leqfShort :: Text - , leqfSchool :: SchoolId + , leqfSchool :: SchoolId + , leqfUrl :: Maybe Text } deriving (Eq, Show) @@ -53,6 +54,7 @@ instance MDMail LetterExpireQualificationF where -- [shamlet|#Ansprache #{html}|] um Html umzuwandeln! -- + instance MDLetter LetterExpireQualificationF where encryptPDFfor _ = NoPassword getLetterKind _ = Din5008 @@ -69,7 +71,8 @@ instance MDLetter LetterExpireQualificationF where ] <> [ toMeta "lang" lang , toMeta "licenceholder" leqfHolderDN - , mbMeta "expiry" (format SelFormatDate <$> leqfExpiry) + , mbMeta "expiry" (format SelFormatDate <$> leqfExpiry) + , mbMeta "licence-url" leqfUrl ] getPJId LetterExpireQualificationF{..} = diff --git a/src/Utils/Print/Letters.hs b/src/Utils/Print/Letters.hs index 83759315e..d3cd2ccb4 100644 --- a/src/Utils/Print/Letters.hs +++ b/src/Utils/Print/Letters.hs @@ -152,6 +152,9 @@ paperKind Plain = "a4wht" -- Ohne Logo paperKind Din5008 = "a4log" -- Mit Logo paperKind PlainLogo = "a4log" +templateHtml :: LetterKind -> Text +-- templateHtml Din5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/generic_template.html") +templateHtml _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/generic_template.html") --------------- diff --git a/templates/letter/fraport_f_expiry.md b/templates/letter/fraport_f_expiry.md index ee8b76fe1..8df73e7ea 100644 --- a/templates/letter/fraport_f_expiry.md +++ b/templates/letter/fraport_f_expiry.md @@ -65,7 +65,12 @@ nicht mehr gültig. $if(supervisor)$ -$licenceholder$ darf +$if(licence-url)$ +[$licenceholder$]($licence-url$) +$else$ +$licenceholder$ +$endif$ +darf $else$ Sie dürfen $endif$ @@ -83,7 +88,7 @@ Telefon Email - : $email$ + : [$email$](mailto:$email$) $else$ Hierfür wenden Sie sich bitte an Ihren Arbeitgeber. @@ -109,7 +114,11 @@ $else$ $endif$ $if(supervisor)$ - $licenceholder$ +$if(licence-url)$ +[$licenceholder$]($licence-url$) +$else$ +$licenceholder$ +$endif$ $else$ You $endif$ @@ -128,7 +137,7 @@ Phone Email - : $email$ + : [$email$](mailto:$email$) $else$ Please contact your employer to book a course for you. diff --git a/templates/letter/generic_template.html b/templates/letter/generic_template.html index f3183bebf..4a752f3e8 100644 --- a/templates/letter/generic_template.html +++ b/templates/letter/generic_template.html @@ -4,26 +4,259 @@ - $for(author-meta)$ - $endfor$ $if(date-meta)$ - $endif$ $if(keywords)$ - $endif$ - $if(title-prefix)$$title-prefix$ \8211 $endif$$pagetitle$ + + $for(author-meta)$ $endfor$ + $if(date-meta)$ $endif$ + $if(keywords)$ + $endif$ + $if(title-prefix)$$title-prefix$ \8211 $endif$$pagetitle$ $for(css)$ - $endfor$ $if(math)$ $math$ $endif$ + $if(document-css)$ +html { +$if(mainfont)$ + font-family: $mainfont$; +$endif$ +$if(fontsize)$ + font-size: $fontsize$; +$endif$ +$if(linestretch)$ + line-height: $linestretch$; +$endif$ + color: $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$; + background-color: $if(backgroundcolor)$$backgroundcolor$$else$#fdfdfd$endif$; +} +body { + margin: 0 auto; + max-width: $if(maxwidth)$$maxwidth$$else$36em$endif$; + padding-left: $if(margin-left)$$margin-left$$else$50px$endif$; + padding-right: $if(margin-right)$$margin-right$$else$50px$endif$; + padding-top: $if(margin-top)$$margin-top$$else$50px$endif$; + padding-bottom: $if(margin-bottom)$$margin-bottom$$else$50px$endif$; + hyphens: auto; + overflow-wrap: break-word; + text-rendering: optimizeLegibility; + font-kerning: normal; +} +@media (max-width: 600px) { + body { + font-size: 0.9em; + padding: 12px; + } + h1 { + font-size: 1.8em; + } +} +@media print { + html { + background-color: $if(backgroundcolor)$$backgroundcolor$$else$white$endif$; + } + body { + background-color: transparent; + color: black; + font-size: 12pt; + } + p, h2, h3 { + orphans: 3; + widows: 3; + } + h2, h3, h4 { + page-break-after: avoid; + } +} +p { + margin: 1em 0; +} +a { + color: $if(linkcolor)$$linkcolor$$else$#1a1a1a$endif$; +} +a:visited { + color: $if(linkcolor)$$linkcolor$$else$#1a1a1a$endif$; +} +img { + max-width: 100%; +} +h1, h2, h3, h4, h5, h6 { + margin-top: 1.4em; +} +h5, h6 { + font-size: 1em; + font-style: italic; +} +h6 { + font-weight: normal; +} +ol, ul { + padding-left: 1.7em; + margin-top: 1em; +} +li > ol, li > ul { + margin-top: 0; +} +blockquote { + margin: 1em 0 1em 1.7em; + padding-left: 1em; + border-left: 2px solid #e6e6e6; + color: #606060; +} +$if(abstract)$ +div.abstract { + margin: 2em 2em 2em 2em; + text-align: left; + font-size: 85%; +} +div.abstract-title { + font-weight: bold; + text-align: center; + padding: 0; + margin-bottom: 0.5em; +} +$endif$ +code { + font-family: $if(monofont)$$monofont$$else$Menlo, Monaco, Consolas, 'Lucida Console', monospace$endif$; +$if(monobackgroundcolor)$ + background-color: $monobackgroundcolor$; + padding: .2em .4em; +$endif$ + font-size: 85%; + margin: 0; + hyphens: manual; +} +pre { + margin: 1em 0; +$if(monobackgroundcolor)$ + background-color: $monobackgroundcolor$; + padding: 1em; +$endif$ + overflow: auto; +} +pre code { + padding: 0; + overflow: visible; + overflow-wrap: normal; +} +.sourceCode { + background-color: transparent; + overflow: visible; +} +hr { + background-color: #1a1a1a; + border: none; + height: 1px; + margin: 1em 0; +} +table { + margin: 1em 0; + border-collapse: collapse; + width: 100%; + overflow-x: auto; + display: block; + font-variant-numeric: lining-nums tabular-nums; +} +table caption { + margin-bottom: 0.75em; +} +tbody { + margin-top: 0.5em; + border-top: 1px solid $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$; + border-bottom: 1px solid $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$; +} +th { + border-top: 1px solid $if(fontcolor)$$fontcolor$$else$#1a1a1a$endif$; + padding: 0.25em 0.5em 0.25em 0.5em; +} +td { + padding: 0.125em 0.5em 0.25em 0.5em; +} +header { + margin-bottom: 4em; + text-align: center; +} +#TOC li { + list-style: none; +} +#TOC ul { + padding-left: 1.3em; +} +#TOC > ul { + padding-left: 0; +} +#TOC a:not(:hover) { + text-decoration: none; +} +$endif$ +code{white-space: pre-wrap;} +span.smallcaps{font-variant: small-caps;} +div.columns{display: flex; gap: min(4vw, 1.5em);} +div.column{flex: auto; overflow-x: auto;} +div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;} +/* The extra [class] is a hack that increases specificity enough to + override a similar rule in reveal.js */ +ul.task-list[class]{list-style: none;} +ul.task-list li input[type="checkbox"] { + font-size: inherit; + width: 0.8em; + margin: 0 0.8em 0.2em -1.6em; + vertical-align: middle; +} +$if(quotes)$ +q { quotes: "“" "”" "‘" "’"; } +$endif$ +$if(displaymath-css)$ +.display.math{display: block; text-align: center; margin: 0.5rem auto;} +$endif$ +$if(highlighting-css)$ +/* CSS for syntax highlighting */ +$highlighting-css$ +$endif$ +$if(csl-css)$ +/* CSS for citations */ +div.csl-bib-body { } +div.csl-entry { + clear: both; +$if(csl-entry-spacing)$ + margin-bottom: $csl-entry-spacing$; +$endif$ +} +.hanging-indent div.csl-entry { + margin-left:2em; + text-indent:-2em; +} +div.csl-left-margin { + min-width:2em; + float:left; +} +div.csl-right-inline { + margin-left:2em; + padding-left:1em; +} +div.csl-indent { + margin-left: 2em; +} +$endif$ + + $for(css)$ $endfor$ + $if(math)$ $math$ $endif$ - $for(header-includes)$ - $header-includes$ $endfor$ + $for(header-includes)$ $header-includes$ $endfor$ - $for(include-before)$ $include-before$ $endfor$ $if(title)$
+ + $for(include-before)$ $include-before$ $endfor$ + $if(title)$

$title$

$if(subtitle)$

$subtitle$

$endif$ $for(author)$

$author$

$endfor$ $if(date)$

$date$

$endif$ -
- $endif$ $if(toc)$ - $endif$ $body$ $for(include-after)$ $include-after$ $endfor$ +
+ $endif$ + $if(toc)$ + $endif$ + + $if(is-de)$ $de-opening$ $else$ $en-opening$ $endif$ + $body$ + $if(is-de)$ $de-closing$ $else$ $en-closing$ $endif$ + + $for(include-after)$ $include-after$ $endfor$ + \ No newline at end of file