module Heist.Extra.Splices.Pandoc (
  RenderCtx (..),
  pandocSplice,
  -- | To delegate rendering of blocks and inlines from a custom splice.
  rpBlock,
  rpInline,
) where

import Heist.Extra.Splices.Pandoc.Ctx (
  RenderCtx (..),
  concatSpliceFunc,
 )
import Heist.Extra.Splices.Pandoc.Footnotes (
  footnoteRefSplice,
  gatherFootnotes,
  renderFootnotesWith,
 )
import Heist.Extra.Splices.Pandoc.Render (
  renderPandocWith,
  rpBlock,
  rpInline,
 )
import Heist.Interpreted qualified as HI
import Text.Pandoc.Definition (Pandoc (..))

-- | A splice to render a Pandoc AST
pandocSplice ::
  RenderCtx ->
  Pandoc ->
  HI.Splice Identity
pandocSplice :: RenderCtx -> Pandoc -> Splice Identity
pandocSplice RenderCtx
ctx Pandoc
doc = do
  -- Create a new context to render footnote references
  let footnotes :: Footnotes
footnotes = Pandoc -> Footnotes
gatherFootnotes Pandoc
doc
      docCtx :: RenderCtx
docCtx =
        RenderCtx
ctx
          { inlineSplice :: Inline -> Maybe (Splice Identity)
inlineSplice = forall (f :: Type -> Type) t a.
Alternative f =>
(t -> f a) -> (t -> f a) -> t -> f a
concatSpliceFunc (RenderCtx -> Inline -> Maybe (Splice Identity)
inlineSplice RenderCtx
ctx) (RenderCtx -> Footnotes -> Inline -> Maybe (Splice Identity)
footnoteRefSplice RenderCtx
docCtx Footnotes
footnotes)
          }
  -- Render main document
  Template
docNodes <- RenderCtx -> Pandoc -> Splice Identity
renderPandocWith RenderCtx
docCtx Pandoc
doc
  -- Render footnotes themselves, but without recursing into inner footnotes.
  Template
footnotesNodes <- RenderCtx -> Footnotes -> Splice Identity
renderFootnotesWith RenderCtx
ctx Footnotes
footnotes
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Template
docNodes forall a. Semigroup a => a -> a -> a
<> Template
footnotesNodes