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 :: Pandoc -> [[Block]]
gatherFootnotes = forall a. Eq a => [a] -> [a]
List.nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
W.query Inline -> [[Block]]
queryFootnotes
  where
    queryFootnotes :: Inline -> [[Block]]
queryFootnotes = \case
      B.Note [Block]
footnote ->
        [[Block]
footnote]
      Inline
_ ->
        []

lookupFootnote :: HasCallStack => [B.Block] -> Footnotes -> Int
lookupFootnote :: HasCallStack => [Block] -> [[Block]] -> Int
lookupFootnote [Block]
note [[Block]]
fs =
  forall a. a -> Maybe a -> a
fromMaybe (forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"Missing footnote: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show [Block]
note) forall a b. (a -> b) -> a -> b
$ do
    (forall a. Num a => a -> a -> a
+ Int
1) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex [Block]
note [[Block]]
fs

renderFootnotesWith :: RenderCtx -> Footnotes -> HI.Splice Identity
renderFootnotesWith :: RenderCtx -> [[Block]] -> Splice Identity
renderFootnotesWith RenderCtx
ctx [[Block]]
fs' =
  forall a. a -> Maybe a -> a
fromMaybe (forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []) forall a b. (a -> b) -> a -> b
$ do
    [[Block]]
fs <- forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList [[Block]]
fs'
    Node
renderNode <- forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Node -> Template
X.childElementsTag Text
"Note:List") forall a b. (a -> b) -> a -> b
$ RenderCtx -> Maybe Node
rootNode RenderCtx
ctx
    let footnotesWithIdx :: [(Int, [Block])]
footnotesWithIdx = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] [[Block]]
fs
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
      Node -> Splices (Splice Identity) -> Splice Identity
runCustomNode Node
renderNode forall a b. (a -> b) -> a -> b
$ do
        Text
"footnote" forall k v. k -> v -> MapSyntax k v
##
          (forall (n :: Type -> Type).
Monad n =>
Splices (Splice n) -> Splice n
HI.runChildrenWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (RenderCtx -> Int -> [Block] -> Splices (Splice Identity)
footnoteSplices RenderCtx
ctx)) forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` [(Int, [Block])]
footnotesWithIdx

footnoteSplices :: RenderCtx -> Int -> [B.Block] -> H.Splices (HI.Splice Identity)
footnoteSplices :: RenderCtx -> Int -> [Block] -> Splices (Splice Identity)
footnoteSplices RenderCtx
ctx Int
idx [Block]
bs = do
  let footnoteDoc :: Pandoc
footnoteDoc = Meta -> [Block] -> Pandoc
Pandoc forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ case [Block]
bs of
        [B.Para [Inline]
is] ->
          -- Optimize for the most usual case, by discarding the paragraph,
          -- which adds unnecessary styling (thus margins).
          forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
B.Plain [Inline]
is
        [Block]
_ ->
          [Block]
bs
  Text
"footnote:idx" forall k v. k -> v -> MapSyntax k v
## forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (forall b a. (Show a, IsString b) => a -> b
show Int
idx)
  Text
"footnote:content" forall k v. k -> v -> MapSyntax k v
## RenderCtx -> Pandoc -> Splice Identity
renderPandocWith RenderCtx
ctx Pandoc
footnoteDoc

footnoteRefSplice :: RenderCtx -> [[B.Block]] -> B.Inline -> Maybe (HI.Splice Identity)
footnoteRefSplice :: RenderCtx -> [[Block]] -> Inline -> Maybe (Splice Identity)
footnoteRefSplice RenderCtx
ctx [[Block]]
footnotes Inline
inline = do
  B.Note [Block]
bs <- forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Inline
inline
  let idx :: Int
idx = HasCallStack => [Block] -> [[Block]] -> Int
lookupFootnote [Block]
bs [[Block]]
footnotes
  Node
renderNode <- forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Node -> Template
X.childElementsTag Text
"Note:Ref") (RenderCtx -> Maybe Node
rootNode RenderCtx
ctx)
  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
    Node -> Splices (Splice Identity) -> Splice Identity
runCustomNode Node
renderNode forall a b. (a -> b) -> a -> b
$
      RenderCtx -> Int -> [Block] -> Splices (Splice Identity)
footnoteSplices RenderCtx
ctx Int
idx [Block]
bs