chore(print): various, also add caching to pdf generation
This commit is contained in:
Steffen Jost
parent
5fd28c0150
commit
226f718f8a
@ -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.
|
||||
@ -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".
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user