fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(letter): applying metadata to template working now as intended

Browse Source
This commit is contained in:
Steffen Jost 2022-07-12 17:43:20 +02:00
parent 104794a210
commit 21c0015ba0
4 changed files with 127 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
src/Handler/PrintCenter.hs
View File

@ -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

50
src/Utils/Print.hs
View File

@ -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
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

15
templates/letter/fraport_renewal.md
View File

@ -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)$
<!-- deutsche Version des Briefes -->
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$
<!-- englische Version des Briefes -->
your apron diving licence is about to expire soon.

37
testdata/test_letters.hs vendored
View File

@ -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
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