chore(letter): sending of multiple user letter with proper language interpolation
This commit is contained in:
Steffen Jost
parent
db48d11ba6
commit
94feda10c2
@ -8,4 +8,5 @@ PrintRecipient: Empfänger
|
||||
PrintSender !ident-ok: Sender
|
||||
PrintCourse: Kurse
|
||||
PrintQualification: Qualifikation
|
||||
PrintPDF !ident-ok: PDF
|
||||
PrintPDF !ident-ok: PDF
|
||||
PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden
|
||||
@ -8,4 +8,5 @@ PrintRecipient: Recipient
|
||||
PrintSender: Sender
|
||||
PrintCourse: Course
|
||||
PrintQualification: Qualification
|
||||
PrintPDF: PDF
|
||||
PrintPDF: PDF
|
||||
PrintManualRenewal: Manual sending of an apron driving licence renewal letter
|
||||
@ -1,11 +1,9 @@
|
||||
{-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Handler.PrintCenter
|
||||
( getPrintCenterR, postPrintCenterR
|
||||
, getPrintSendR , postPrintSendR
|
||||
, getPrintDownloadR
|
||||
-- TODO: for testing only, remove exports
|
||||
, mprToMeta
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -20,6 +18,7 @@ import qualified Text.Pandoc as P
|
||||
import qualified Text.Pandoc.Builder as P
|
||||
|
||||
import Database.Persist.Sql (updateWhereCount)
|
||||
import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
@ -55,11 +54,11 @@ instance Default MetaPinRenewal where
|
||||
{ mppRecipient = "Papa Schlumpf"
|
||||
, mppAddress = plaintextToStoredMarkup ("Erdbeerweg 42\n98726 Schlumpfhausen"::Text)
|
||||
, mppLogin = "keiner123"
|
||||
, mppPin = "898989"
|
||||
, mppPin = "89998a"
|
||||
, mppURL = Nothing
|
||||
, mppDate = fromGregorian 2022 07 27
|
||||
, mppLang = "de-de"
|
||||
, mppOpening = Just "Lieber $recipient$ Schlumpfi,"
|
||||
, mppOpening = Just "Lieber Schlumpfi,"
|
||||
, mppClosing = Nothing
|
||||
}
|
||||
|
||||
@ -82,8 +81,12 @@ validateMetaPinRenewal = do
|
||||
MetaPinRenewal{..} <- State.get
|
||||
guardValidation MsgMppBadLanguage $ isDe mppLang || isEn mppLang
|
||||
|
||||
|
||||
-- TODO: formatTimeUser SelFormatDate now (Entity <$> printJobRecipient recipient)
|
||||
|
||||
mprToMeta :: MetaPinRenewal -> P.Meta
|
||||
mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat
|
||||
-- formatTimeUser SelFormatDate mppDate mppRecipient
|
||||
[ toMeta "recipient" mppRecipient
|
||||
, toMeta "address" (mppAddress & html2textlines)
|
||||
, toMeta "login" mppLogin
|
||||
@ -106,7 +109,8 @@ mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat
|
||||
html2textlines sm = T.lines . LT.toStrict $ markupInput sm
|
||||
|
||||
|
||||
data PJTableAction = PJActAcknowledge
|
||||
|
||||
data PJTableAction = PJActAcknowledge
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
|
||||
|
||||
@ -158,16 +162,16 @@ resultCourse = _dbrOutput . _4 . _Just
|
||||
resultQualification :: Traversal' PJTableData (Entity Qualification)
|
||||
resultQualification = _dbrOutput . _5 . _Just
|
||||
|
||||
pjTableQuery :: PJTableExpr -> E.SqlQuery
|
||||
pjTableQuery :: PJTableExpr -> E.SqlQuery
|
||||
( E.SqlExpr (Entity PrintJob)
|
||||
, E.SqlExpr (Maybe (Entity User))
|
||||
, E.SqlExpr (Maybe (Entity User))
|
||||
, E.SqlExpr (Maybe (Entity Course))
|
||||
, E.SqlExpr (Maybe (Entity Qualification)))
|
||||
pjTableQuery (printJob `E.LeftOuterJoin` recipient
|
||||
`E.LeftOuterJoin` sender
|
||||
pjTableQuery (printJob `E.LeftOuterJoin` recipient
|
||||
`E.LeftOuterJoin` sender
|
||||
`E.LeftOuterJoin` course
|
||||
`E.LeftOuterJoin` quali ) = do
|
||||
`E.LeftOuterJoin` quali ) = do
|
||||
E.on $ printJob E.^. PrintJobRecipient E.==. recipient E.?. UserId
|
||||
E.on $ printJob E.^. PrintJobSender E.==. sender E.?. UserId
|
||||
E.on $ printJob E.^. PrintJobCourse E.==. course E.?. CourseId
|
||||
@ -175,25 +179,25 @@ pjTableQuery (printJob `E.LeftOuterJoin` recipient
|
||||
return (printJob, recipient, sender, course, quali)
|
||||
|
||||
mkPJTable :: DB (FormResult (PJTableActionData, Set PrintJobId), Widget)
|
||||
mkPJTable = do
|
||||
mkPJTable = do
|
||||
currentRoute <- fromMaybe (error "mkPJTable called from 404-handler") <$> liftHandler getCurrentRoute -- albeit we do know the route here
|
||||
let
|
||||
let
|
||||
showId :: PrintJobId -> Widget
|
||||
showId k = do
|
||||
showId k = do
|
||||
c <- encrypt k
|
||||
let f :: CryptoUUIDPrintJob -> Text
|
||||
f x = toPathPiece x
|
||||
let f :: CryptoUUIDPrintJob -> Text
|
||||
f x = toPathPiece x
|
||||
[whamlet|#{f c}|]
|
||||
dbtSQLQuery = pjTableQuery
|
||||
dbtRowKey = queryPrintJob >>> (E.^. PrintJobId)
|
||||
dbtProj = dbtProjFilteredPostId
|
||||
dbtColonnade = mconcat
|
||||
dbtColonnade = mconcat
|
||||
[ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged)
|
||||
, sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n
|
||||
, sortable (Just "pj-created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t
|
||||
, sortable (toNothingS "pdf") (i18nCell MsgPrintPDF) $ \( view $ resultPrintJob . _entityKey -> k) -> anchorCellM (PrintDownloadR <$> encrypt k) (showId k)
|
||||
-- , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> textCell (tshow . E.unSqlBackendKey $ unPrintJobKey k)
|
||||
-- , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> cell (showId k)
|
||||
, sortable (Just "pj-created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t
|
||||
-- , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> cell (showId k)
|
||||
, sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n
|
||||
, sortable (Just "pj-acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t
|
||||
, sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR
|
||||
, sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR
|
||||
@ -202,26 +206,32 @@ mkPJTable = do
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ single ("pj-name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName))
|
||||
-- , single ("pj-id" , SortColumn $ queryPrintJob >>> (E.^. PrintJobId))
|
||||
, single ("pj-created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated))
|
||||
, single ("pj-acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged))
|
||||
-- , single ("pj-id" , SortColumn $ queryPrintJob >>> (E.^. PrintJobId))
|
||||
, single ("pj-created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated))
|
||||
, single ("pj-acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged))
|
||||
, single ("pj-recipient" , sortUserNameBareM queryRecipient)
|
||||
, single ("pj-sender" , sortUserNameBareM querySender )
|
||||
, single ("pj-course" , SortColumn $ queryCourse >>> (E.?. CourseName))
|
||||
, single ("pj-qualification", SortColumn $ queryQualification >>> (E.?. QualificationName))
|
||||
, single ("pj-course" , SortColumn $ queryCourse >>> (E.?. CourseName))
|
||||
, single ("pj-qualification", SortColumn $ queryQualification >>> (E.?. QualificationName))
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single ("pj-name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName))
|
||||
, single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
|
||||
-- TODO: continue here
|
||||
[ single ("pj-name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName))
|
||||
, single ("pj-recipient" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient) (E.?. UserDisplayName))
|
||||
, single ("pj-sender" , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender) (E.?. UserDisplayName))
|
||||
, single ("pj-course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName))
|
||||
, single ("pj-qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName))
|
||||
, single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ prismAForm (singletonFilter "pj-name" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobName)
|
||||
, prismAForm (singletonFilter "acknowledged" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged)
|
||||
-- TODO: continue here
|
||||
[ prismAForm (singletonFilter "pj-name" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobName)
|
||||
, prismAForm (singletonFilter "pj-recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient)
|
||||
, prismAForm (singletonFilter "pj-sender" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintSender)
|
||||
, prismAForm (singletonFilter "pj-course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse)
|
||||
, prismAForm (singletonFilter "pj-qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintQualification)
|
||||
, prismAForm (singletonFilter "acknowledged" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged)
|
||||
]
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
|
||||
dbtIdent :: Text
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "print-job"
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
@ -233,7 +243,7 @@ mkPJTable = do
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional
|
||||
= let acts :: Map PJTableAction (AForm Handler PJTableActionData)
|
||||
acts = mconcat
|
||||
acts = mconcat
|
||||
[ singletonMap PJActAcknowledge $ pure PJActAcknowledgeData
|
||||
]
|
||||
in renderAForm FormStandard
|
||||
@ -249,25 +259,27 @@ mkPJTable = do
|
||||
(First (Just act), jobMap) <- inp
|
||||
let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
|
||||
return (act, jobSet)
|
||||
over _1 postprocess <$> dbTable def DBTable{..}
|
||||
psValidator = def & defaultSorting [SortAscBy "pj-created"]
|
||||
& defaultFilter (singletonMap "acknowledged" [toPathPiece False])
|
||||
over _1 postprocess <$> dbTable psValidator DBTable{..}
|
||||
|
||||
getPrintCenterR, postPrintCenterR :: Handler Html
|
||||
getPrintCenterR = postPrintCenterR
|
||||
postPrintCenterR = do
|
||||
currentRoute <- fromMaybe (error "printCenterR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
|
||||
(pjRes, pjTable) <- runDB mkPJTable
|
||||
(pjRes, pjTable) <- runDB mkPJTable
|
||||
|
||||
formResult pjRes $ \case
|
||||
formResult pjRes $ \case
|
||||
(PJActAcknowledgeData, pjIds) -> do
|
||||
let setPJIds = Set.toList pjIds
|
||||
now <- liftIO getCurrentTime
|
||||
num <- runDB $ updateWhereCount [PrintJobAcknowledged ==. Nothing, PrintJobId <-. setPJIds] [PrintJobAcknowledged =. Just now]
|
||||
num <- runDB $ updateWhereCount [PrintJobAcknowledged ==. Nothing, PrintJobId <-. setPJIds] [PrintJobAcknowledged =. Just now]
|
||||
addMessageI Success $ MsgPrintJobAcknowledge num
|
||||
redirect currentRoute
|
||||
|
||||
siteLayoutMsg MsgMenuApc $ do
|
||||
setTitleI MsgMenuApc
|
||||
$(widgetFile "print-center")
|
||||
$(widgetFile "print-center") -- i18nWidgetFile? Currently no text contained; displays just the table only
|
||||
|
||||
|
||||
getPrintSendR, postPrintSendR :: Handler Html
|
||||
@ -276,34 +288,55 @@ postPrintSendR = do
|
||||
((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm $ Just def
|
||||
let procFormSend mpr = do
|
||||
-- addMessage Info . toHtml $ "Brief wird gesendet an " <> mppRecipient
|
||||
e_pdf <- pdfRenewal $ mprToMeta mpr
|
||||
-- now <- liftIO getCurrentTime
|
||||
case e_pdf of
|
||||
Right bs -> do
|
||||
let meta = mprToMeta mpr
|
||||
receivers <- runDB $ Ex.select $ do
|
||||
user <- Ex.from $ Ex.table @User
|
||||
Ex.where_ $ E.val (mppRecipient mpr) `E.isInfixOf` (user E.^. UserIdent)
|
||||
pure user
|
||||
letters <- case receivers of
|
||||
[] -> pure . (Nothing ,) <$> pdfRenewal meta
|
||||
_ -> forM receivers $ \usr -> do
|
||||
mDate <- formatTimeUser SelFormatDate (mppDate mpr) (Just usr)
|
||||
let u = entityVal usr
|
||||
paras = [(k,v) | (k, Just v) <- [
|
||||
("lang" , userLanguages u >>= (listToMaybe . view _Wrapped)) -- auch möglich `op Languages` statt `view _Wrapped`
|
||||
]] ++
|
||||
[ ("date" , mDate)
|
||||
, ("recipient" , userDisplayName u)
|
||||
]
|
||||
pdf <- pdfRenewal $ applyMetas paras meta
|
||||
return (Just $ entityKey usr, pdf)
|
||||
oks <- forM letters $ \case
|
||||
(mbRecipient, Right bs) -> do
|
||||
-- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY
|
||||
-- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf"
|
||||
uID <- maybeAuthId
|
||||
filepath <- runDB $ sendLetter "Test-Brief" bs Nothing uID Nothing Nothing
|
||||
addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> filepath
|
||||
redirect PrintCenterR
|
||||
Left err -> addMessage Error . toHtml $ P.renderError err
|
||||
-- TODO: continue here with acutal letter sending!
|
||||
return $ Just ()
|
||||
mbPdfLink <- formResultMaybe sendResult procFormSend
|
||||
-- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
|
||||
siteLayoutMsg MsgMenuPrintSend $ do
|
||||
filepath <- runDB $ sendLetter "Test-Brief" bs mbRecipient uID Nothing Nothing
|
||||
addMessage Success $ toHtml $ "Druckauftrag angelegt: " <> filepath
|
||||
-- TODO: continue here with acutal letter sending!
|
||||
pure True
|
||||
(Nothing, Left err) -> do
|
||||
addMessage Error . toHtml $ P.renderError err
|
||||
pure False
|
||||
(Just uid, Left err) -> do
|
||||
addMessage Error . toHtml $ "For uid " <> tshow uid <> ": " <> P.renderError err
|
||||
pure False
|
||||
when (or oks) $ redirect PrintCenterR
|
||||
formResult sendResult procFormSend
|
||||
-- actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
|
||||
siteLayoutMsg MsgPrintManualRenewal $ 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") -- i18nWidgetFile? Currently no text contained; displays just the form only
|
||||
|
||||
|
||||
getPrintDownloadR :: CryptoUUIDPrintJob -> Handler TypedContent
|
||||
getPrintDownloadR cupj = do
|
||||
pjId <- decrypt cupj
|
||||
PrintJob {..} <- runDB $ get404 pjId
|
||||
getPrintDownloadR cupj = do
|
||||
pjId <- decrypt cupj
|
||||
PrintJob {..} <- runDB $ get404 pjId
|
||||
sendByteStringAsFile printJobFilename printJobFile printJobCreated
|
||||
{- for PrintJobFile :: FileContentReference use this code, however, requires instances
|
||||
HasFileReference PrintJob and IsFileReference PrintJob which seemed to complicated... :(
|
||||
@ -315,4 +348,4 @@ getPrintDownloadR cupj = do
|
||||
E.where_ (pj E.^. PrintJobId E.==. E.val pjId)
|
||||
-- return file entity
|
||||
return pj
|
||||
-}
|
||||
-}
|
||||
@ -16,8 +16,12 @@ import qualified Text.Pandoc.Builder as P
|
||||
|
||||
-- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?
|
||||
|
||||
-- TODO: Handler.Utils.Pandoc and this module need to be sorted.
|
||||
-- Some stuff might be moved vice versa; maybe rename to Utils.Pandoc?!
|
||||
{- Recall:
|
||||
Funktionen außerhalb der Hanlder-Monade gehören in Utils-Module;
|
||||
ansonsten drohen zyklische Abhängikeiten, d.h.
|
||||
ggf. Funktionen in der HandlerFor-Monade nach Handler.Utils.Print verschieben!
|
||||
-}
|
||||
|
||||
|
||||
|
||||
-------------------------
|
||||
@ -223,13 +227,17 @@ pdfRenewal' meta = do
|
||||
|
||||
sendLetter :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB FilePath
|
||||
sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do
|
||||
recipient <- fmap userDisplayName . join <$> mapM get printJobRecipient
|
||||
sender <- fmap userDisplayName . join <$> mapM get printJobRecipient
|
||||
course <- fmap (CI.original . courseShorthand ) . join <$> mapM get printJobCourse
|
||||
quali <- fmap (CI.original . qualificationShorthand) . join <$> mapM get printJobQualification
|
||||
recipient <- join <$> mapM get printJobRecipient
|
||||
sender <- join <$> mapM get printJobSender
|
||||
course <- join <$> mapM get printJobCourse
|
||||
quali <- join <$> mapM get printJobQualification
|
||||
let nameRecipient = userDisplayName <$> recipient
|
||||
nameSender = userDisplayName <$> sender
|
||||
nameCourse = CI.original . courseShorthand <$> course
|
||||
nameQuali = CI.original . qualificationShorthand <$> quali
|
||||
let printJobAcknowledged = Nothing
|
||||
printJobFilename = unpack $ (T.intercalate "_" . catMaybes $ [Just printJobName, quali, course, sender, recipient]) <> ".pdf"
|
||||
-- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code
|
||||
printJobFilename = unpack $ (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) <> ".pdf"
|
||||
-- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code
|
||||
printJobFile = LBS.toStrict pdf
|
||||
-- TODO: system call to lpr here!
|
||||
printJobCreated <- liftIO getCurrentTime
|
||||
|
||||
@ -1,12 +1,3 @@
|
||||
<section>
|
||||
<h2>
|
||||
Vorfeldführerschein Renewal-Briefes versenden
|
||||
<p>
|
||||
^{sendForm}
|
||||
$maybe pdfLink <- mbPdfLink
|
||||
<section>
|
||||
<h2>Soeben versendeter Brief
|
||||
<p>
|
||||
#{show pdfLink}
|
||||
<p>
|
||||
TODO: Hier Link auf generiertem Brief anzeigen
|
||||
23
testdata/test_letters.hs
vendored
23
testdata/test_letters.hs
vendored
@ -21,6 +21,29 @@ 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"
|
||||
|
||||
-- Current Function found in Handler.PrintCenter, but is no longer exported!
|
||||
mprToMeta :: MetaPinRenewal -> P.Meta
|
||||
mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat
|
||||
[ toMeta "recipient" mppRecipient
|
||||
, toMeta "address" (mppAddress & html2textlines)
|
||||
, 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
|
||||
deOrEn = if isDe mppLang then "de" else "en"
|
||||
keyOpening = deOrEn <> "-opening"
|
||||
keyClosing = deOrEn <> "-closing"
|
||||
mbMeta :: P.ToMetaValue a => Text -> Maybe a -> Map Text P.MetaValue
|
||||
mbMeta = foldMap . toMeta
|
||||
toMeta :: P.ToMetaValue a => Text -> a -> Map Text P.MetaValue
|
||||
toMeta k = singletonMap k . P.toMetaValue
|
||||
html2textlines :: StoredMarkup -> [Text]
|
||||
html2textlines sm = T.lines . LT.toStrict $ markupInput sm
|
||||
|
||||
test :: IO T.Text
|
||||
test = do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user