From 226f718f8adff9702e058ac7814f90f536acb3d0 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 6 Jul 2022 18:02:31 +0200 Subject: [PATCH] chore(print): various, also add caching to pdf generation --- .../categories/qualification/de-de-formal.msg | 10 +++ .../categories/qualification/en-eu.msg | 10 +++ src/Handler/Admin/Apc.hs | 70 ++++++++----------- src/Utils/Print.hs | 20 +++++- templates/letter/din5008.latex | 8 ++- 5 files changed, 72 insertions(+), 46 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index ad49c35d3..8a2c57f2b 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -52,3 +52,13 @@ LmsActRenewNotify: Neue zufällige E-Lernen PIN zuweisen und Benachrichtigung pe LmsNotificationSend n@Int: E-Lernen Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet. LmsPinRenewal n@Int: E-Lernen Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}. LmsActionFailed n@Int: Aktion nicht durchgeführt für #{n} #{pluralDE n "Person" "Personen"}, da diese derzeit nicht an einer Prüfung teilnehmen. +MppOpening: Anrede +MppClosing: Grußformel +MppDate: Datum +MppURL: Link Prüfung +MppLogin: LOGIN +MppPin: PIN +MppRecipient: Empfänger +MppAddress: Adresse +MppLang: Sprache +MppBadLanguage: Sprache muss derzeit "de" oder "en" sein. \ No newline at end of file diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index c71a0d92e..d4ea87c62 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -52,3 +52,13 @@ LmsActRenewNotify: Randomly replace e-learning PIN and re-send notification by p LmsNotificationSend n@Int: E-learning notifications will be sent to #{n} #{pluralENs n "examinee"} by letter post or by email. LmsPinRenewal n@Int: E-learning pin replaced randomly for #{n} #{pluralENs n "examinee"}. LmsActionFailed n@Int: No action for #{n} #{pluralENs n "person"}, since there was no ongoing examination. +MppOpening: Opening +MppClosing: Closing +MppDate: Date +MppURL: Link Examination +MppLogin: Login +MppPin: Pin +MppRecipient: Recipient +MppAddress: Address +MppLang: Language +MppBadLanguage: Language currently restricted to "en" or "de". \ No newline at end of file diff --git a/src/Handler/Admin/Apc.hs b/src/Handler/Admin/Apc.hs index 67efbdcf3..1f6104434 100644 --- a/src/Handler/Admin/Apc.hs +++ b/src/Handler/Admin/Apc.hs @@ -6,15 +6,19 @@ module Handler.Admin.Apc ) where import Import +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +-- import qualified Data.ByteString.Lazy as LBS import qualified Text.Pandoc as P import qualified Text.Pandoc.Builder as P + +import qualified Control.Monad.State.Class as State -- import Utils.Print --- import qualified Control.Monad.State.Class as State -- import Data.Aeson (encode) -- import qualified Data.Text as Text -- import qualified Data.Set as Set --- import Handler.Utils +import Handler.Utils data MetaPinRenewal = MetaPinRenewal { mppOpening :: Maybe Text @@ -24,7 +28,7 @@ data MetaPinRenewal = MetaPinRenewal , mppLogin :: Text , mppPin :: Text , mppRecipient :: Text - , mppAddress :: [Text] + , mppAddress :: StoredMarkup , mppLang :: Text } deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -38,61 +42,43 @@ formToMetaValues MetaPinRenewal{..} = P.Meta $ mconcat , toMeta "login" mppLogin , toMeta "pin" mppPin , toMeta "recipient" mppRecipient - , toMeta "address" mppAddress + , toMeta "address" (mppAddress & html2textlines) , toMeta "lang" mppLang ] where mbMeta = foldMap . toMeta toMeta k = singletonMap k . P.toMetaValue + html2textlines :: StoredMarkup -> [Text] + html2textlines sm = T.lines . LT.toStrict $ markupInput sm + -{- makeRenewalForm :: Maybe MetaPinRenewal -> Form MetaPinRenewal makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateMetaPinRenewal $ \html -> flip (renderAForm FormStandard) html $ MetaPinRenewal - <$> aopt textField (fslI MsgMppOpening) (mppOpening <$> tmpl) - <*> aopt textField (fslI MsgMppClosing) (mppClosing <$> tmpl) - <*> aopt textField (fslI MsgMppDate) (mppDate <$> tmpl) - <*> aopt textField (fslI MsgMppURL) (mppURL <$> tmpl) - <*> areq textField (fslI MsgMppLogin) (mppLogin <$> tmpl) - <*> areq textField (fslI MsgMppLogin) (mppLogin <$> tmpl) - <*> areq textField (fslI MsgMppLogin) (mppLogin <$> tmpl) - <*> areq textField (fslI MsgMppLogin) (mppLogin <$> tmpl) - <*> areq textField (fslI MsgMppLogin) (mppLogin <$> tmpl) - <*> areq boolField (fslI MsgMppIsDe) (mppIsDe <$> tmpl) + <$> aopt textField (fslI MsgMppOpening) (mppOpening <$> tmpl) + <*> aopt textField (fslI MsgMppClosing) (mppClosing <$> tmpl) + <*> aopt textField (fslI MsgMppDate) (mppDate <$> tmpl) + <*> aopt textField (fslI MsgMppURL) (mppURL <$> tmpl) + <*> areq textField (fslI MsgMppLogin) (mppLogin <$> tmpl) + <*> areq textField (fslI MsgMppPin) (mppPin <$> tmpl) + <*> areq textField (fslI MsgMppRecipient) (mppRecipient <$> tmpl) + <*> areq htmlField (fslI MsgMppAddress) (mppAddress <$> tmpl) + <*> areq textField (fslI MsgMppLang) ((mppLang <$> tmpl) <|> Just "de-de") + -validateMetaPinReneqal :: FormValidator MetaPinRenewal Handler () -validateMetaPinReneqal = do - AvsQueryPeMetaPinRenewalate.get - guardValidation MsgAvsQueryEmpty $ - is _Just avsPersonQueryCardNo || - is _Just avsPersonQueryFirstName || - is _Just avsPersonQueryLastName || - is _Just avsPersonQueryInternalPersonalNo || - is _Just avsPersonQueryVersionNo +validateMetaPinRenewal :: FormValidator MetaPinRenewal Handler () +validateMetaPinRenewal = do + MetaPinRenewal{..} <- State.get + guardValidation MsgMppBadLanguage $ + isPrefixOf "de" mppLang + || isPrefixOf "en" mppLang -makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus -makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html -> - flip (renderAForm FormStandard) html $ - parseAvsIds <$> areq textField (fslI MsgAvsCardNo) (unparseAvsIds <$> tmpl) - where - parseAvsIds :: Text -> AvsQueryStatus - parseAvsIds txt = AvsQueryStatus $ Set.fromList ids - where - nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt - ids = catMaybes $ readMay <$> nonemptys - unparseAvsIds :: AvsQueryStatus -> Text - unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids -validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler () -validateAvsQueryStatus = do - AvsQueryStatus ids <- State.get - guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids) --} getAdminApcR, postAdminApcR :: Handler Html getAdminApcR = postAdminApcR postAdminApcR = do {- - ((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing + ((presult, pwidget), penctype) <- runFormPost $ makeRenewalForm Nothing let procFormPerson fr = do res <- runAvsPersonSearch fr case res of diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 62761cbbd..e5cd5695e 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -16,6 +16,10 @@ 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?! + + ------------------------- -- Hardcoded Templates -- ------------------------- @@ -89,6 +93,7 @@ setIsDeFromLang m 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 doc1 <- areader readerOpts strictMarkupInput let writerOpts = def { P.writerTemplate = Just tmpl } P.writeMarkdown writerOpts @@ -105,7 +110,7 @@ reTemplateLetter meta StoredMarkup{..} = do MarkupMarkdown -> P.readMarkdown MarkupPlaintext -> P.readMarkdown ---pdfDIN5008 :: P.PandocMonad m => Text -> m L.ByteString +--pdfDIN5008 :: P.PandocMonad m => Text -> m L.ByteString -- for pandoc > 2.18 pdfDIN5008 :: Text -> P.PandocIO L.ByteString pdfDIN5008 md = do tmpl <- compileTemplate templateDIN5008 @@ -113,3 +118,16 @@ pdfDIN5008 md = do writerOpts = def { P.writerTemplate = Just tmpl } doc <- P.readMarkdown readerOpts md makePDF writerOpts doc + + +pdfDIN5008' :: Text -> HandlerFor UniWorX (Either P.PandocError L.ByteString) +pdfDIN5008' md = do + etmpl <- $cachedHereBinary ("din5008"::Text) (liftIO . P.runIO $ compileTemplate templateDIN5008) + case etmpl of + Left err -> return $ Left err + Right tmpl -> liftIO . P.runIO $ do + let readerOpts = def { P.readerExtensions = P.pandocExtensions } + writerOpts = def { P.writerTemplate = Just tmpl } + doc <- P.readMarkdown readerOpts md + makePDF writerOpts doc + diff --git a/templates/letter/din5008.latex b/templates/letter/din5008.latex index 5cfdf8224..9413fcc4e 100644 --- a/templates/letter/din5008.latex +++ b/templates/letter/din5008.latex @@ -8,7 +8,7 @@ fromlogo=false, % don't show logo in letter head version=last, % latest version of KOMA letter pagenumber=botright, % show pagenumbers on bottom right - firstfoot=true + firstfoot=true % first-page footer ]{scrlttr2} \PassOptionsToPackage{hyphens}{url} @@ -71,6 +71,8 @@ $else$ \usepackage{unicode-math} $endif$ +\usepackage[a4paper, bmargin=8cm]{geometry} %%% TODO + \usepackage{parskip} \usepackage{graphics} @@ -91,7 +93,7 @@ $endif$ \addtolength{\oddsidemargin}{-1in} \setlength{\textwidth}{\useplength{firstheadwidth}} -\usepackage[absolute,showboxes,quiet]{textpos} +\usepackage[absolute,showboxes,quiet,overlay]{textpos} \setlength{\TPHorizModule}{5mm} \setlength{\TPVertModule}{\TPHorizModule} @@ -132,7 +134,7 @@ $endif$ \vspace{1.2cm} \closing{$closing$} - \ps $postskriptum$ + %\ps $postskriptum$ $if(encludes)$ \setkomavar*{enclseparator}{Anlage}