116 lines
4.2 KiB
Haskell
116 lines
4.2 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?
|
|
|
|
-------------------------
|
|
-- 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
|
|
, T.isPrefixOf "de" t
|
|
= P.setMeta isde True m
|
|
| otherwise = P.deleteMeta isde m
|
|
where
|
|
isde = "is-de"
|
|
|
|
|
|
|
|
-------------------------
|
|
-- 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
|
|
doc1 <- areader readerOpts strictMarkupInput
|
|
let writerOpts = def { P.writerTemplate = Just tmpl }
|
|
P.writeMarkdown writerOpts
|
|
$ appMeta setIsDeFromLang
|
|
$ addMeta meta doc1
|
|
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
|
|
|
|
--pdfDIN5008 :: P.PandocMonad m => Text -> m L.ByteString
|
|
pdfDIN5008 :: Text -> P.PandocIO L.ByteString
|
|
pdfDIN5008 md = do
|
|
tmpl <- compileTemplate templateDIN5008
|
|
let readerOpts = def { P.readerExtensions = P.pandocExtensions }
|
|
writerOpts = def { P.writerTemplate = Just tmpl }
|
|
doc <- P.readMarkdown readerOpts md
|
|
makePDF writerOpts doc
|