chore(print): generalize pandoc printing

package.yaml

@@ -147,6 +147,7 @@ dependencies:
   - extended-reals
   - rfc5051
   - unidecode
+  - doctemplates
   - pandoc
   - pandoc-types
   - insert-ordered-containers

src/Handler/Admin/Apc.hs

@@ -1,16 +1,21 @@
+{-# OPTIONS -Wno-unused-top-binds #-}      -- TODO: remove me, for debugging only
+
 module Handler.Admin.Apc
   ( getAdminApcR
   , postAdminApcR  
   ) where
 
 import Import
+import qualified Text.Pandoc          as P
+import qualified Text.Pandoc.Builder  as P
+-- 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
-{-
+
 data MetaPinRenewal = MetaPinRenewal 
       { mppOpening   :: Maybe Text 
       , mppClosing   :: Maybe Text 
@@ -19,13 +24,29 @@ data MetaPinRenewal = MetaPinRenewal
       , mppLogin     :: Text 
       , mppPin       :: Text
       , mppRecipient :: Text
-      , mppAdress    :: [Text]
+      , mppAddress   :: [Text]
       , mppLang      :: Text 
       , mppIsDe      :: Bool
       }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
+formToMetaValues :: MetaPinRenewal -> P.Meta 
+formToMetaValues MetaPinRenewal{..} = P.Meta . mconcat $ catMaybes
+  [ toMeta "opening"    <$> mppOpening
+  , toMeta "closing"    <$> mppClosing
+  , toMeta "date"       <$> mppDate
+  , toMeta "url"        <$> mppURL
+  , toMeta "login"      mppLogin      & pure
+  , toMeta "pin"        mppPin        & pure
+  , toMeta "recipient"  mppRecipient  & pure
+  , toMeta "address"    mppAddress    & pure
+  , toMeta "lang"       mppLang       & pure
+  , toMeta "is-de"      mppIsDe       & pure
+  ]
+  where     
+    toMeta k = singletonMap k . P.toMetaValue
 
+{-
 makePrintForm :: Maybe MetaPinRenewal -> Form MetaPinRenewal
 makePrintForm tmpl = identifyForm FIDLmsLetter . validateForm validateMetaPinRenewal $ \html -> 
   flip (renderAForm FormStandard) html $ MetaPinRenewal

src/Handler/Admin/Test.hs

@@ -4,8 +4,8 @@ module Handler.Admin.Test
   , getAdminTestPdfR
   ) where
 
-import Import hiding (embedFile)
+import Import 
-import Data.FileEmbed (embedFile)
+import Utils.Print 
 
 import Handler.Utils
 import Jobs
@@ -279,17 +279,16 @@ postAdminTestR = do
 
 getAdminTestPdfR :: Handler TypedContent
 getAdminTestPdfR = do
+  -- uUser <- maybeAuth -- to determine language for test 
   templates <- liftIO $ do
-    let letter_md = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
+    letter_tp <- P.compileTemplate "" templateRenewal
-    letter_tp <- P.compileTemplate "" letter_md
+    din5008   <- P.compileTemplate "" templateDIN5008
-    let din5008_tex = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
-    din5008 <- P.compileTemplate "" din5008_tex
     now       <- getCurrentTime
-    return (now, letter_md, letter_tp, din5008)
+    return (now, letter_tp, din5008)
   case templates of
-    (_,_,Left err,_) -> sendResponseStatus internalServerError500 $ tshow err
+    (_,Left err,_) -> sendResponseStatus internalServerError500 $ tshow err
-    (_,_,_,Left err) -> sendResponseStatus internalServerError500 $ tshow err
+    (_,_,Left err) -> sendResponseStatus internalServerError500 $ tshow err
-    (now, md, Right templ, Right latex) -> do
+    (now, Right templ, Right latex) -> do
       content <- liftIO . P.runIO $ do
         let texopts = []
             readeropts  = def { P.readerExtensions = P.pandocExtensions }
@@ -297,7 +296,7 @@ getAdminTestPdfR = do
             writeropts2 = def { P.writerTemplate = Just latex }
           -- https://github.com/jgm/pandoc/issues/1950
           -- using markdown as a template for itself for interpolation:
-        doc1 <- P.readMarkdown  readeropts  md
+        doc1 <- P.readMarkdown  readeropts  templateRenewal
         doc2 <- P.writeMarkdown writeropts1 doc1
         doc3 <- P.readMarkdown  readeropts  doc2
         P.makePDF "lualatex" texopts P.writeLaTeX writeropts2 $

src/Utils/Print.hs

@@ -0,0 +1,65 @@
+module Utils.Print where
+
+import Import.NoModel
+import qualified Data.Foldable as Fold
+-- hiding (foldr) import Data.Foldable (foldr)
+
+import Control.Monad.Except
+import Import hiding (embedFile)
+import Data.FileEmbed (embedFile)
+
+import qualified Text.DocTemplates    as P
+import qualified Text.Pandoc          as P
+-- import qualified Text.Pandoc.PDF     as P
+import qualified Text.Pandoc.Builder  as P
+
+-- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?
+
+templateRenewal :: Text
+templateRenewal = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
+
+templateDIN5008 :: Text
+templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
+
+
+-- setMeta :: (HasMeta a, ToMetaValue b) => Text -> b -> a -> a 
+
+-- foldr :: forall b. (Element mono0 -> b -> b) -> b -> mono0 -> b
+
+
+applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, a) -> p -> p 
+applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas
+
+addMeta :: P.Meta -> P.Pandoc -> P.Pandoc
+addMeta m p = meta <> p
+  where meta = P.Pandoc m mempty
+
+
+-- reTemplateLetter :: (P.PandocMonad m, P.TemplateMonad m, Foldable t, P.ToMetaValue a) => t (Text, a) -> StoredMarkup -> m Text
+reTemplateLetter :: (P.TemplateMonad m, P.PandocMonad m) => P.Meta -> StoredMarkup -> m Text
+reTemplateLetter meta StoredMarkup{..}  = do
+  let strictMarkupInput = toStrict markupInput
+  mdTemplate <- P.compileTemplate "" strictMarkupInput
+  case mdTemplate of 
+    (Left err) -> throwError . P.PandocTemplateError $ pack err 
+    (Right templ) -> do
+      let readeropts = def { P.readerExtensions = P.pandocExtensions }
+          writeropts = def { P.writerTemplate = Just templ }
+          -- reader :: (P.PandocMonad m, P.ToSources a)	 => P.ReaderOptions	-> a	-> m P.Pandoc	 
+          areader = case markupInputFormat of 
+            MarkupHtml      -> P.readHtml
+            MarkupMarkdown  -> P.readMarkdown
+            MarkupPlaintext -> P.readMarkdown
+      doc1 <- areader readeropts strictMarkupInput      
+      P.writeMarkdown writeropts $ addMeta meta doc1 -- should we apply metas here?
+      
+
+{-
+
+renewalLetter :: (Foldable t, ToMetaValue b, PandocMonad m) => t (Text, b) -> PandocMonad m -> Text 
+renewalLetter 
+
+pdfDIN5008 :: MetaPinRenewal -> IO (Either ByteString ByteString)
+pdfDIN5008 
+
+-}

templates/letter/din5008.latex

@@ -6,8 +6,9 @@
     fromphone=true,      % show phone number
     fromemail=true,      % show email
     fromlogo=false,      % don't show logo in letter head
-    version=last         % latest version of KOMA letter
+    version=last,        % latest version of KOMA letter
-    pagenumber=botright  % show pagenumbers on bottom right
+    pagenumber=botright, % show pagenumbers on bottom right
+    firstfoot=true 
 ]{scrlttr2}
 
 \PassOptionsToPackage{hyphens}{url}