208 lines
8.3 KiB
Haskell
208 lines
8.3 KiB
Haskell
module Utils.Print where
|
|
|
|
import Import.NoModel
|
|
-- import qualified Data.Foldable as Fold
|
|
-- hiding (foldr) import Data.Foldable (foldr)
|
|
|
|
-- import qualified Data.Text as T
|
|
import qualified Data.ByteString.Lazy as L
|
|
import Control.Monad.Except
|
|
import Import hiding (embedFile)
|
|
import Data.FileEmbed (embedFile)
|
|
|
|
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?
|
|
|
|
-- 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 --
|
|
-------------------------
|
|
|
|
templateRenewal :: Text
|
|
templateRenewal = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
|
|
|
|
templateDIN5008 :: Text
|
|
templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex")
|
|
|
|
|
|
|
|
----------------------
|
|
-- Pandoc Functions --
|
|
----------------------
|
|
-- Either I don't understand how pandoc works or
|
|
-- I don't understand why these are not included
|
|
|
|
compileTemplate :: (P.PandocMonad m) => Text -> m (P.Template Text)
|
|
compileTemplate tmpl = do
|
|
let partialPath = "" -- no partials used, see Text.DocTemplates
|
|
mbTemplate <- P.runWithDefaultPartials $ P.compileTemplate partialPath tmpl
|
|
liftEither $ str2pandocError mbTemplate
|
|
where
|
|
str2pandocError = over _Left $ P.PandocTemplateError . pack
|
|
|
|
makePDF :: P.WriterOptions -> P.Pandoc -> P.PandocIO L.ByteString
|
|
-- makePDF :: (PandocMonad m, MonadIO m, MonadMask m) => P.WriterOptions -> P.Pandoc -> m L.ByteString -- only pandoc >= 2.18
|
|
makePDF wopts doc = do
|
|
mbPdf <- P.makePDF "lualatex" texopts P.writeLaTeX wopts doc
|
|
liftEither $ bs2pandocError mbPdf
|
|
where
|
|
texopts = []
|
|
bs2pandocError = over _Left (P.PandocMakePDFError . decodeUtf8 . L.toStrict)
|
|
|
|
-- | Modify the Meta-Block of Pandoc
|
|
appMeta :: (P.Meta -> P.Meta) -> P.Pandoc -> P.Pandoc
|
|
appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs
|
|
|
|
-- applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, a) -> p -> p
|
|
-- applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas
|
|
|
|
-- | Add meta to pandoc. Existing variables will be overwritten.
|
|
addMeta :: P.Meta -> P.Pandoc -> P.Pandoc
|
|
addMeta m = appMeta (<> m)
|
|
--addMeta m p = meta <> p
|
|
-- where meta = P.Pandoc m mempty
|
|
|
|
-- | Pandoc conditionals only test if a variable is set or isn't set.
|
|
-- Variable "is-de" will be set to True if the "lang" variable starts with "de"
|
|
-- and will be unset otherwise
|
|
setIsDeFromLang :: P.Meta -> P.Meta
|
|
setIsDeFromLang m
|
|
| (Just (P.MetaString t)) <- P.lookupMeta "lang" m
|
|
, isDe t = P.setMeta isde True m
|
|
| otherwise = P.deleteMeta isde m
|
|
where
|
|
isde = "is-de"
|
|
|
|
defReaderOpts :: P.ReaderOptions
|
|
defReaderOpts = def { P.readerExtensions = P.pandocExtensions, P.readerStripComments = True }
|
|
|
|
defWriterOpts :: P.Template Text -> P.WriterOptions
|
|
defWriterOpts t = def { P.writerExtensions = P.pandocExtensions, P.writerTemplate = Just t }
|
|
|
|
|
|
-------------------------
|
|
-- Readers and writers --
|
|
-------------------------
|
|
|
|
-- | Apply StoredMarkup as a template to itself and return the resulting Markup
|
|
-- This is a hack to allow variable interpolation within a document.
|
|
-- Pandoc currently only allows interpolation within templates.
|
|
-- An alternative Route would be to use Builders, but this prevents User-edited Markup Templates
|
|
reTemplateLetter :: P.PandocMonad m => P.Meta -> StoredMarkup -> m Text
|
|
reTemplateLetter meta StoredMarkup{..} = do
|
|
tmpl <- compileTemplate strictMarkupInput
|
|
doc <- areader readerOpts strictMarkupInput
|
|
let writerOpts = def { P.writerExtensions = P.pandocExtensions
|
|
, P.writerTemplate = Just tmpl }
|
|
P.writeMarkdown writerOpts
|
|
$ appMeta setIsDeFromLang
|
|
$ addMeta meta doc
|
|
where
|
|
strictMarkupInput = toStrict markupInput
|
|
readerOpts = def { P.readerExtensions = P.pandocExtensions
|
|
, P.readerStripComments = True
|
|
}
|
|
-- 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
|
|
|
|
reTemplateLetter' :: P.PandocMonad m => P.Meta -> Text -> m Text
|
|
reTemplateLetter' meta md = do
|
|
tmpl <- compileTemplate md
|
|
doc <- P.readMarkdown readerOpts md
|
|
let writerOpts = def { P.writerExtensions = P.pandocExtensions
|
|
, P.writerTemplate = Just tmpl }
|
|
P.writeMarkdown writerOpts
|
|
$ appMeta setIsDeFromLang
|
|
$ addMeta meta doc
|
|
where
|
|
readerOpts = def { P.readerExtensions = P.pandocExtensions
|
|
, P.readerStripComments = True
|
|
}
|
|
|
|
|
|
--pdfDIN5008 :: P.PandocMonad m => Text -> m L.ByteString -- for pandoc > 2.18
|
|
pdfDIN5008' :: P.Meta -> Text -> P.PandocIO L.ByteString
|
|
pdfDIN5008' meta md = do
|
|
tmpl <- compileTemplate templateDIN5008
|
|
let readerOpts = def { P.readerExtensions = P.pandocExtensions }
|
|
writerOpts = def { P.writerExtensions = P.pandocExtensions
|
|
, P.writerTemplate = Just tmpl }
|
|
doc <- P.readMarkdown readerOpts md
|
|
makePDF writerOpts
|
|
$ appMeta setIsDeFromLang
|
|
$ addMeta meta doc
|
|
|
|
-- | creates a PDF using the din5008 template
|
|
pdfDIN5008 :: P.Meta -> Text -> HandlerFor UniWorX (Either P.PandocError L.ByteString)
|
|
pdfDIN5008 meta md = do
|
|
e_tmpl <- $cachedHereBinary ("din5008"::Text) (liftIO . P.runIO $ compileTemplate templateDIN5008)
|
|
actRight e_tmpl $ \tmpl -> liftIO . P.runIO $ do
|
|
let readerOpts = def { P.readerExtensions = P.pandocExtensions }
|
|
writerOpts = def { P.writerExtensions = P.pandocExtensions
|
|
, P.writerTemplate = Just tmpl }
|
|
doc <- P.readMarkdown readerOpts md
|
|
makePDF writerOpts
|
|
$ appMeta setIsDeFromLang
|
|
$ addMeta meta doc
|
|
|
|
|
|
|
|
-------------------------
|
|
-- Specialized Letters --
|
|
-------------------------
|
|
|
|
-- | like 'reTemplateLetter' but uses 'templateRenewal' and caches the result
|
|
mdRenewal' :: P.Meta -> HandlerFor UniWorX (Either P.PandocError Text)
|
|
mdRenewal' meta = do
|
|
let readerOpts = def { P.readerExtensions = P.pandocExtensions
|
|
, P.readerStripComments = True
|
|
}
|
|
e_doc <- $cachedHereBinary ("renewal-pandoc"::Text) (liftIO . P.runIO $ P.readMarkdown readerOpts templateRenewal)
|
|
e_tmpl <- $cachedHereBinary ("renewal-template"::Text) (liftIO . P.runIO $ compileTemplate templateRenewal)
|
|
case (e_doc, e_tmpl) of
|
|
(Left err, _) -> pure $ Left err
|
|
(_, Left err) -> pure $ Left err
|
|
(Right md_doc, Right md_tmpl) -> do
|
|
let writerOpts = def { P.writerExtensions = P.pandocExtensions
|
|
, P.writerTemplate = Just md_tmpl
|
|
}
|
|
liftIO . P.runIO $ P.writeMarkdown writerOpts $ appMeta setIsDeFromLang
|
|
$ addMeta meta md_doc
|
|
|
|
-- | like 'reTemplateLetter' but uses 'templateRenewal' and caches the result
|
|
mdRenewal :: P.Meta -> HandlerFor UniWorX (Either P.PandocError Text)
|
|
mdRenewal meta = runExceptT $ do
|
|
let readerOpts = def { P.readerExtensions = P.pandocExtensions
|
|
, P.readerStripComments = True
|
|
}
|
|
doc <- ExceptT $ $cachedHereBinary ("renewal-pandoc"::Text) (pure . P.runPure $ P.readMarkdown readerOpts templateRenewal)
|
|
tmpl <- ExceptT $ $cachedHereBinary ("renewal-template"::Text) (pure . P.runPure $ compileTemplate templateRenewal)
|
|
let writerOpts = def { P.writerExtensions = P.pandocExtensions
|
|
, P.writerTemplate = Just tmpl
|
|
}
|
|
ExceptT . pure . P.runPure $ P.writeMarkdown writerOpts $ appMeta setIsDeFromLang
|
|
$ addMeta meta doc
|
|
|
|
|
|
-- | combines 'mdRenewal' and 'pdfDIN5008'
|
|
pdfRenewal :: P.Meta -> HandlerFor UniWorX (Either P.PandocError L.ByteString)
|
|
pdfRenewal meta = do
|
|
e_txt <- mdRenewal' meta
|
|
--actRight e_txt (pdfDIN5008 . appMeta setIsDeFromLang . addMeta meta) -- try this
|
|
actRight e_txt $ pdfDIN5008 meta
|
|
|
|
-- | like pdfRenewal but without caching
|
|
pdfRenewal' :: P.Meta -> P.PandocIO L.ByteString
|
|
pdfRenewal' meta = do
|
|
doc <- reTemplateLetter' meta templateRenewal
|
|
pdfDIN5008' meta doc
|