chore(letter): use proper caching for pdf generation via pandoc

src/Handler/Qualification.hs

@@ -410,7 +410,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
           <*>  view    (resultQualUser . _entityVal . _qualificationUserScheduleRenewal)
           <*>  getStatusPlusTxt
           <*>  getStatusPlusDay
-        getCompanies cmps = case mapMaybe (flip Map.lookup cmpMap . view (_entityVal .  _userCompanyCompany)) cmps of 
+        getCompanies cmps = case mapMaybe (flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany)) cmps of 
           []        -> pure   Nothing
           somecmps  -> pure $ Just $ intercalate ", " $ fmap (view (_companyName . _CI)) somecmps
         getCompanyNos = pure . CsvSemicolonList . mapMaybe (preview (_Just . _companyAvsId) . flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany))

src/Utils/Print.hs

@@ -42,7 +42,7 @@ import Text.Hamlet
 import System.Exit
 import System.Process.Typed -- for calling pdftk for pdf encryption
 
--- import Handler.Utils.Memcached
+import Handler.Utils.Memcached
 import Handler.Utils.Users
 import Handler.Utils.DateTime
 import Handler.Utils.Mail
@@ -50,7 +50,7 @@ import Handler.Utils.Widgets (nameHtml')
 import Handler.Utils.Avs (updateReceivers)
 import Jobs.Handler.SendNotification.Utils
 
--- import Utils.Print.Instances
+import Utils.Print.Instances ()
 import Utils.Print.Letters
 import Utils.Print.RenewQualification
 import Utils.Print.CourseCertificate
@@ -110,29 +110,29 @@ import Utils.Print.CourseCertificate
 
 
 -- | read and writes markdown, applying it as its own template to apply meta
-mdTemplating :: Text -> P.Meta -> HandlerFor UniWorX (Either P.PandocError P.Pandoc)
+mdTemplating :: Text -> P.Meta -> HandlerFor UniWorX (Either Text P.Pandoc)
 mdTemplating template meta = runExceptT $ do
   let readerOpts = def  { P.readerExtensions    = P.pandocExtensions
                         , P.readerStripComments = True
                         }
-  -- doc  <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("pandoc-md: \n"   <> template) (pure . P.runPure $ P.readMarkdown readerOpts template)
+  -- doc  <- ExceptT (pure . over _Left P.renderError . P.runPure $ P.readMarkdown readerOpts template)
-  -- tmpl <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("template-md: \n" <> template) (pure . P.runPure $ compileTemplate template)
+  -- tmpl <- ExceptT (pure . over _Left P.renderError . P.runPure $ compileTemplate template)
-  doc  <- ExceptT (pure . P.runPure $ P.readMarkdown readerOpts template)
+  doc  <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("pandoc-md: \n"   <> template) (pure . over _Left P.renderError . P.runPure $ P.readMarkdown readerOpts template)
-  tmpl <- ExceptT (pure . P.runPure $ compileTemplate template)
+  tmpl <- ExceptT $ memcachedBy (Just . Right $ 6 * diffHour) ("template-md: \n" <> template) (pure . over _Left P.renderError . P.runPure $ compileTemplate template)
   let writerOpts = def { P.writerExtensions = P.pandocExtensions
                        , P.writerTemplate = Just tmpl
                        }
-  ExceptT . pure . P.runPure $ do
+  ExceptT . pure . over _Left P.renderError . P.runPure $ do
     md_txt <- P.writeMarkdown writerOpts $ appMeta setIsDeFromLang $ addMeta meta doc
     P.readMarkdown readerOpts md_txt
 
 
 -- | creates a PDF using a LaTeX template
-pdfLaTeX :: LetterKind -> P.Pandoc -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString)
+pdfLaTeX :: LetterKind -> P.Pandoc -> HandlerFor UniWorX (Either Text LBS.ByteString)
 pdfLaTeX lk doc = do
-  e_tmpl <- liftIO . P.runIO $ compileTemplate $ templateLatex lk
+  -- e_tmpl <- fmap (over _Left P.renderError) . liftIO . P.runIO $ compileTemplate $ templateLatex lk
-  -- e_tmpl <- memcachedBy (Just . Right $ 6 * diffHour) ("LetterKind-latex: \n" <> tshow lk) (liftIO . P.runIO $ compileTemplate $ templateLatex lk)
+  e_tmpl <- memcachedBy (Just . Right $ 6 * diffHour) ("LetterKind-latex: \n" <> tshow lk) (fmap (over _Left P.renderError) . liftIO . P.runIO $ compileTemplate $ templateLatex lk)
-  actRight e_tmpl $ \tmpl -> liftIO . P.runIO $ do
+  actRight e_tmpl $ \tmpl -> fmap (over _Left P.renderError) .liftIO . P.runIO $ do
       let writerOpts  = def { P.writerExtensions = P.pandocExtensions
                             , P.writerTemplate   = Just tmpl }      
       makePDF writerOpts $ appMeta setIsDeFromLang doc
@@ -156,8 +156,8 @@ renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
             --, toMeta "rcvr-email"    $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise
             ]
   e_md <- mdTemplating tmpl meta
-  result <- actRight e_md $ pdfLaTeX kind
+  actRight e_md $ pdfLaTeX kind
-  return $ over _Left P.renderError result
+  -- return $ over _Left P.renderError result
 
 -- TODO: apcIdent does not make sense for multiple letters 
 renderLetters :: (MDLetter l, Foldable f) => Entity User -> f l -> Text -> Handler (Either Text LBS.ByteString)
@@ -185,8 +185,9 @@ renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent
                 Right doc2 -> pure $ Right $ doc1 <> doc2
 
       doc <- foldrM templateCombine (Right mempty) mdls
-      result <- actRight doc $ pdfLaTeX kind
+      -- result <- actRight doc $ pdfLaTeX kind
-      return $ over _Left P.renderError result
+      -- return $ over _Left P.renderError result
+      actRight doc $ pdfLaTeX kind
   | otherwise = return $ Left "renderLetters received empty set of letters"
 
 

src/Utils/Print/Instances.hs

@@ -0,0 +1,66 @@
+-- SPDX-FileCopyrightText: 2022-23 Steffen Jost <jost@tcs.ifi.lmu.de>
+--
+-- SPDX-License-Identifier: AGPL-3.0-or-later
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Utils.Print.Instances where
+
+import Import.NoModel
+-- import Import
+
+import qualified Text.DocTemplates.Internal as D
+import qualified Text.DocLayout      as D
+import qualified Text.Pandoc         as P
+
+-----------------------------
+-- Pandoc Orphan Instances --
+-----------------------------
+
+-- deriving anyclass instance Generic IOException
+-- deriving anyclass instance Binary IOException
+-- deriving anyclass instance Binary HttpException
+-- deriving anyclass instance Binary P.PandocError
+
+
+-- required for memcaching compiled markdown and LaTeX templates
+instance Binary P.RowHeadColumns
+instance Binary P.RowSpan 
+instance Binary P.ColWidth
+instance Binary P.ColSpan
+instance Binary P.Alignment
+instance Binary P.TableHead
+instance Binary P.TableBody
+instance Binary P.TableFoot
+instance Binary P.MathType
+instance Binary P.Cell
+instance Binary P.Caption
+instance Binary P.Citation
+instance Binary P.CitationMode
+instance Binary P.ListNumberStyle
+instance Binary P.ListNumberDelim
+instance Binary P.Format
+instance Binary P.QuoteType
+instance Binary P.Inline
+instance Binary P.Row
+instance Binary P.Block
+instance Binary P.MetaValue
+instance Binary P.Meta
+instance Binary P.Pandoc
+
+-- -- and for memchaching a LaTeX template
+deriving instance Binary D.Border
+deriving instance Binary D.Alignment
+deriving instance Binary D.Pipe
+deriving instance Binary D.Variable
+deriving instance (Binary a) => Binary (D.Doc a)
+deriving instance (Binary a) => Binary (P.Template a)
+
+deriving instance NFData D.Border
+deriving instance NFData D.Alignment
+deriving instance NFData D.Pipe
+deriving instance NFData D.Variable
+deriving instance (NFData a) => NFData (D.Doc a)
+deriving instance (NFData a) => NFData (P.Template a)
+
+-- TODO: sadly this is not yet enough.