From 21c0015ba0dbd575d0a472d9834df03b81e0e6f6 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 12 Jul 2022 17:43:20 +0200 Subject: [PATCH] chore(letter): applying metadata to template working now as intended --- src/Handler/PrintCenter.hs | 70 +++++++++++++++-------------- src/Utils/Print.hs | 50 ++++++++++++++++----- templates/letter/fraport_renewal.md | 15 +++++++ testdata/test_letters.hs | 37 ++++++++++++++- 4 files changed, 127 insertions(+), 45 deletions(-) diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 3e28ab9a2..51a1240ce 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -1,8 +1,8 @@ {-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only module Handler.PrintCenter - ( getPrintCenterR, postPrintCenterR - , getPrintSendR , postPrintSendR + ( getPrintCenterR, postPrintCenterR + , getPrintSendR , postPrintSendR -- TODO: for testing only, remove exports , mprToMeta ) where @@ -22,32 +22,32 @@ import Utils.Print import Handler.Utils -data MetaPinRenewal = MetaPinRenewal +data MetaPinRenewal = MetaPinRenewal { mppRecipient :: Text , mppAddress :: StoredMarkup - , mppLogin :: Text + , mppLogin :: Text , mppPin :: Text , mppURL :: Maybe URI , mppDate :: Day , mppLang :: Lang , mppOpening :: Maybe Text - , mppClosing :: Maybe Text + , mppClosing :: Maybe Text } deriving (Eq, Ord, Show, Generic, Typeable) -- TODO: just for testing, remove in production -instance Default MetaPinRenewal where - def = MetaPinRenewal +instance Default MetaPinRenewal where + def = MetaPinRenewal { mppRecipient = "Papa Schlumpf" , mppAddress = plaintextToStoredMarkup ("Erdbeerweg 42\n98726 Schlumpfhausen"::Text) , mppLogin = "keiner123" , mppPin = "898989" - , mppURL = Nothing + , mppURL = Nothing , mppDate = fromGregorian 2022 07 27 , mppLang = "de-de" - , mppOpening = Just "Lieber Papa Schlumpfi," - , mppClosing = Nothing - } + , mppOpening = Just "Lieber $recipient$ Schlumpfi," + , mppClosing = Nothing + } makeRenewalForm :: Maybe MetaPinRenewal -> Form MetaPinRenewal makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateMetaPinRenewal $ \html -> do @@ -64,23 +64,23 @@ makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateMetaPinR <*> aopt textField (fslI MsgMppClosing) (mppClosing <$> tmpl) validateMetaPinRenewal :: FormValidator MetaPinRenewal Handler () -validateMetaPinRenewal = do +validateMetaPinRenewal = do MetaPinRenewal{..} <- State.get guardValidation MsgMppBadLanguage $ isDe mppLang || isEn mppLang -mprToMeta :: MetaPinRenewal -> P.Meta -mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat +mprToMeta :: MetaPinRenewal -> P.Meta +mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat [ toMeta "recipient" mppRecipient , toMeta "address" (mppAddress & html2textlines) - , toMeta "login" mppLogin - , toMeta "pin" mppPin + , toMeta "login" mppLogin + , toMeta "pin" mppPin , mbMeta "url" (mppURL <&> tshow) , toMeta "date" (mppDate & tshow) -- TODO: render according to user preference , toMeta "lang" mppLang , mbMeta keyOpening mppOpening , mbMeta keyClosing mppClosing - ] - where + ] + where deOrEn = if isDe mppLang then "de" else "en" keyOpening = deOrEn <> "-opening" keyClosing = deOrEn <> "-closing" @@ -94,35 +94,39 @@ mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat getPrintCenterR, postPrintCenterR :: Handler Html getPrintCenterR = postPrintCenterR -postPrintCenterR = do +postPrintCenterR = do -- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute siteLayoutMsg MsgMenuApc $ do setTitleI MsgMenuApc - $(widgetFile "print-center") + $(widgetFile "print-center") -getPrintSendR, postPrintSendR:: Handler Html -getPrintSendR = postPrintSendR -postPrintSendR = do +getPrintSendR, postPrintSendR:: Handler TypedContent +getPrintSendR = postPrintSendR +postPrintSendR = do ((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm Nothing let procFormSend mpr@MetaPinRenewal{..} = do addMessage Info . toHtml $ "Brief wird gesendet an " <> mppRecipient e_pdf <- pdfRenewal $ mprToMeta mpr - -- now <- liftIO getCurrentTime - case e_pdf of - Right bs -> do + now <- liftIO getCurrentTime + _ <- case e_pdf of + Right bs -> do liftIO $ LBS.writeFile "/tmp/generated.pdf" bs - addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf" - Left err -> addMessage Error . toHtml $ P.renderError err + sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict bs) now + -- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf" + Left err -> + -- addMessage Error . toHtml $ P.renderError err + sendResponseStatus internalServerError500 $ toTypedContent $ P.renderError err -- TODO: continue here with acutal letter sending! return $ Just () - mbPdfLink <- formResultMaybe sendResult procFormSend + mbPdfLink <- formResultMaybe sendResult procFormSend -- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute - siteLayoutMsg MsgMenuPrintSend $ do - setTitleI MsgMenuPrintSend - let sendForm = wrapForm sendWidget def + answer <- siteLayoutMsg MsgMenuPrintSend $ do + setTitleI MsgMenuPrintSend + let sendForm = wrapForm sendWidget def { formEncoding = sendEnctype -- , formAction = Just $ SomeRoute actionUrl } -- TODO: use i18nWidgetFile instead if this is to become permanent - $(widgetFile "print-send") + $(widgetFile "print-send") + sendResponse $ toTypedContent answer diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 76d792e30..6c69b6a67 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -64,7 +64,7 @@ appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs -- | Add meta to pandoc. Existing variables will be overwritten. addMeta :: P.Meta -> P.Pandoc -> P.Pandoc -addMeta m = appMeta (m <>) +addMeta m = appMeta (<> m) --addMeta m p = meta <> p -- where meta = P.Pandoc m mempty @@ -79,6 +79,11 @@ setIsDeFromLang m where isde = "is-de" +defReaderOpts :: P.ReaderOptions +defReaderOpts = def { P.readerExtensions = P.pandocExtensions, P.readerStripComments = True } + +defWriterOpts :: P.Template Text -> P.WriterOptions +defWriterOpts t = def { P.writerExtensions = P.pandocExtensions, P.writerTemplate = Just t } ------------------------- @@ -91,13 +96,11 @@ setIsDeFromLang m -- An alternative Route would be to use Builders, but this prevents User-edited Markup Templates reTemplateLetter :: P.PandocMonad m => P.Meta -> StoredMarkup -> m Text reTemplateLetter meta StoredMarkup{..} = do - tmpl <- compileTemplate strictMarkupInput - -- TODO: write cacheHere Version using DB Key of StoredMarkup with Unique DB Argument instead of StoredMarkup + tmpl <- compileTemplate strictMarkupInput doc <- areader readerOpts strictMarkupInput let writerOpts = def { P.writerExtensions = P.pandocExtensions , P.writerTemplate = Just tmpl } P.writeMarkdown writerOpts - $ P.setMeta ("foooooo"::Text) ("baaaaaaar"::Text) -- TODO: just for debugging $ appMeta setIsDeFromLang $ addMeta meta doc where @@ -111,26 +114,45 @@ reTemplateLetter meta StoredMarkup{..} = do MarkupMarkdown -> P.readMarkdown MarkupPlaintext -> P.readMarkdown +reTemplateLetter' :: P.PandocMonad m => P.Meta -> Text -> m Text +reTemplateLetter' meta md = do + tmpl <- compileTemplate md + doc <- P.readMarkdown readerOpts md + let writerOpts = def { P.writerExtensions = P.pandocExtensions + , P.writerTemplate = Just tmpl } + P.writeMarkdown writerOpts + $ appMeta setIsDeFromLang + $ addMeta meta doc + where + readerOpts = def { P.readerExtensions = P.pandocExtensions + , P.readerStripComments = True + } + + --pdfDIN5008 :: P.PandocMonad m => Text -> m L.ByteString -- for pandoc > 2.18 -pdfDIN5008' :: Text -> P.PandocIO L.ByteString -pdfDIN5008' md = do +pdfDIN5008' :: P.Meta -> Text -> P.PandocIO L.ByteString +pdfDIN5008' meta md = do tmpl <- compileTemplate templateDIN5008 let readerOpts = def { P.readerExtensions = P.pandocExtensions } writerOpts = def { P.writerExtensions = P.pandocExtensions , P.writerTemplate = Just tmpl } doc <- P.readMarkdown readerOpts md - makePDF writerOpts doc + makePDF writerOpts + $ appMeta setIsDeFromLang + $ addMeta meta doc -- | creates a PDF using the din5008 template -pdfDIN5008 :: Text -> HandlerFor UniWorX (Either P.PandocError L.ByteString) -pdfDIN5008 md = do +pdfDIN5008 :: P.Meta -> Text -> HandlerFor UniWorX (Either P.PandocError L.ByteString) +pdfDIN5008 meta md = do e_tmpl <- $cachedHereBinary ("din5008"::Text) (liftIO . P.runIO $ compileTemplate templateDIN5008) actRight e_tmpl $ \tmpl -> liftIO . P.runIO $ do let readerOpts = def { P.readerExtensions = P.pandocExtensions } writerOpts = def { P.writerExtensions = P.pandocExtensions , P.writerTemplate = Just tmpl } doc <- P.readMarkdown readerOpts md - makePDF writerOpts doc + makePDF writerOpts + $ appMeta setIsDeFromLang + $ addMeta meta doc @@ -176,4 +198,10 @@ pdfRenewal :: P.Meta -> HandlerFor UniWorX (Either P.PandocError L.ByteString) pdfRenewal meta = do e_txt <- mdRenewal' meta --actRight e_txt (pdfDIN5008 . appMeta setIsDeFromLang . addMeta meta) -- try this - actRight e_txt pdfDIN5008 \ No newline at end of file + actRight e_txt $ pdfDIN5008 meta + +-- | like pdfRenewal but without caching +pdfRenewal' :: P.Meta -> P.PandocIO L.ByteString +pdfRenewal' meta = do + doc <- reTemplateLetter' meta templateRenewal + pdfDIN5008' meta doc diff --git a/templates/letter/fraport_renewal.md b/templates/letter/fraport_renewal.md index 2e512bf96..c421a9c39 100644 --- a/templates/letter/fraport_renewal.md +++ b/templates/letter/fraport_renewal.md @@ -34,7 +34,21 @@ address: - Musterstraße 11 - 12345 Musterstadt ... +$if(titleblock)$ +$titleblock$ + +$endif$ +$for(header-includes)$ +$header-includes$ + +$endfor$ +$for(include-before)$ +$include-before$ + +$endfor$ + $if(is-de)$ + die Gültigkeit Ihres Vorfeldführerscheines läuft demnächst ab. Durch die erfolgreiche Teilnahme an einem E-Lernen können Sie @@ -57,6 +71,7 @@ erneut der Grundkurs bei der Fahrerausbildung absolviert werden. Bei Fragen können Sie sich gerne an das Team der Fahrerausbildung wenden. $else$ + your apron diving licence is about to expire soon. diff --git a/testdata/test_letters.hs b/testdata/test_letters.hs index 6fd248d80..5ead70537 100644 --- a/testdata/test_letters.hs +++ b/testdata/test_letters.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- usage: -- > npm run build -- > stack ghci -- testdata/test_letters.hs @@ -17,6 +18,10 @@ import Utils.Print import Handler.PrintCenter +mdTmpl :: Text +mdTmpl = "---\nfoo: fooOrg\nbar: barOrg\n---\nHere is some text\n - foo: $foo$\n - bar: $bar$\nbody\n$body$\nend\n" + + test :: IO T.Text test = do res <- P.runIO $ reTemplateLetter (Handler.PrintCenter.mprToMeta def) (markdownToStoredMarkup templateRenewal) @@ -37,4 +42,34 @@ test3 = do doc1 <- test2 let doc2 = P.setMeta (T.pack "foooooo") (T.pack "baaaaaaar") $ appMeta setIsDeFromLang $ addMeta (mprToMeta def) doc1 writerOpts = def { P.writerExtensions = P.enableExtension P.Ext_yaml_metadata_block P.pandocExtensions} - P.runIOorExplode $ P.writeMarkdown writerOpts doc2 \ No newline at end of file + P.runIOorExplode $ P.writeMarkdown writerOpts doc2 + +test4 = do + pdf <- P.runIOorExplode $ pdfRenewal' $ mprToMeta def + LBS.writeFile "./testgen.pdf" pdf + + +t5meta :: P.Meta +t5meta = P.setMeta "lang" ("de-de"::Text) $ P.setMeta "foo" ("HERE"::Text) mempty + +t5meta2 :: P.Meta +t5meta2 = P.setMeta "lang" ("en-gb"::Text) $ P.setMeta "bar" ("XYZ"::Text) mempty + + +t5redoc :: IO Text +t5redoc = P.runIOorExplode $ reTemplateLetter' t5meta mdTmpl + +t5tmpl :: IO (P.Template Text) +t5tmpl = P.runIOorExplode $ compileTemplate mdTmpl + +t5doc :: IO P.Pandoc +t5doc = P.runIOorExplode $ P.readMarkdown defReaderOpts mdTmpl + +t5reDoc2 :: IO Text +t5reDoc2 = do + t <- t5tmpl + d <- t5doc + let P.Pandoc _ di = d + -- d2 = P.Pandoc t5meta di -- this works + d2 = addMeta t5meta d + P.runIOorExplode $ P.writeMarkdown (defWriterOpts t) d2 \ No newline at end of file