Footnotes.hs

module Heist.Extra.Splices.Pandoc.Footnotes where

import Data.List qualified as List
import Data.Map.Syntax ((##))
import Heist qualified as H
import Heist.Extra (runCustomNode)
import Heist.Extra.Splices.Pandoc.Ctx (RenderCtx (rootNode))
import Heist.Extra.Splices.Pandoc.Render (renderPandocWith)
import Heist.Interpreted qualified as HI
import Text.Pandoc.Builder qualified as B
import Text.Pandoc.Definition (Pandoc (..))
import Text.Pandoc.Walk qualified as W
import Text.XmlHtml qualified as X

type Footnotes = [[B.Block]]

gatherFootnotes :: Pandoc -> Footnotes
gatherFootnotes = List.nub . W.query queryFootnotes
  where
    queryFootnotes = \case
      B.Note footnote ->
        [footnote]
      _ ->
        []

lookupFootnote :: HasCallStack => [B.Block] -> Footnotes -> Int
lookupFootnote note fs =
  fromMaybe (error $ "Missing footnote: " <> show note) $ do
    (+ 1) <$> List.elemIndex note fs

renderFootnotesWith :: RenderCtx -> Footnotes -> HI.Splice Identity
renderFootnotesWith ctx fs' =
  fromMaybe (pure []) $ do
    fs <- viaNonEmpty toList fs'
    renderNode <- viaNonEmpty head $ maybe [] (X.childElementsTag "Note:List") $ rootNode ctx
    let footnotesWithIdx = zip [1 :: Int ..] fs
    Just $
      runCustomNode renderNode $ do
        "footnote" ##
          (HI.runChildrenWith . uncurry (footnoteSplices ctx)) `foldMapM` footnotesWithIdx

footnoteSplices :: RenderCtx -> Int -> [B.Block] -> H.Splices (HI.Splice Identity)
footnoteSplices ctx idx bs = do
  let footnoteDoc = Pandoc mempty $ case bs of
        [B.Para is] ->
          -- Optimize for the most usual case, by discarding the paragraph,
          -- which adds unnecessary styling (thus margins).
          one $ B.Plain is
        _ ->
          bs
  "footnote:idx" ## HI.textSplice (show idx)
  "footnote:content" ## renderPandocWith ctx footnoteDoc

footnoteRefSplice :: RenderCtx -> [[B.Block]] -> B.Inline -> Maybe (HI.Splice Identity)
footnoteRefSplice ctx footnotes inline = do
  B.Note bs <- pure inline
  let idx = lookupFootnote bs footnotes
  renderNode <- viaNonEmpty head $ maybe [] (X.childElementsTag "Note:Ref") (rootNode ctx)
  Just $
    runCustomNode renderNode $
      footnoteSplices ctx idx bs