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 = [[Block]] -> [[Block]]
forall a. Eq a => [a] -> [a]
List.nub ([[Block]] -> [[Block]])
-> (Pandoc -> [[Block]]) -> Pandoc -> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> [[Block]]) -> Pandoc -> [[Block]]
forall c. Monoid c => (Inline -> c) -> Pandoc -> 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 =
  Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Text -> Int
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text
"Missing footnote: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Block] -> Text
forall b a. (Show a, IsString b) => a -> b
show [Block]
note) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ do
    (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> [[Block]] -> Maybe Int
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' =
  Splice Identity -> Maybe (Splice Identity) -> Splice Identity
forall a. a -> Maybe a -> a
fromMaybe (Template -> Splice Identity
forall a. a -> HeistT Identity Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []) (Maybe (Splice Identity) -> Splice Identity)
-> Maybe (Splice Identity) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ do
    [[Block]]
fs <- (NonEmpty [Block] -> [[Block]]) -> [[Block]] -> Maybe [[Block]]
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty [Block] -> [[Block]]
forall a. NonEmpty a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList [[Block]]
fs'
    Node
renderNode <- (NonEmpty Node -> Node) -> Template -> Maybe Node
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty Node -> Node
forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head (Template -> Maybe Node) -> Template -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Template -> (Node -> Template) -> Maybe Node -> Template
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Node -> Template
X.childElementsTag Text
"Note:List") (Maybe Node -> Template) -> Maybe Node -> Template
forall a b. (a -> b) -> a -> b
$ RenderCtx -> Maybe Node
rootNode RenderCtx
ctx
    let footnotesWithIdx :: [(Int, [Block])]
footnotesWithIdx = [Int] -> [[Block]] -> [(Int, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] [[Block]]
fs
    Splice Identity -> Maybe (Splice Identity)
forall a. a -> Maybe a
Just (Splice Identity -> Maybe (Splice Identity))
-> Splice Identity -> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$
      Node -> Splices (Splice Identity) -> Splice Identity
runCustomNode Node
renderNode (Splices (Splice Identity) -> Splice Identity)
-> Splices (Splice Identity) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ do
        Text
"footnote" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
##
          (Splices (Splice Identity) -> Splice Identity
forall (n :: Type -> Type).
Monad n =>
Splices (Splice n) -> Splice n
HI.runChildrenWith (Splices (Splice Identity) -> Splice Identity)
-> ((Int, [Block]) -> Splices (Splice Identity))
-> (Int, [Block])
-> Splice Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Block] -> Splices (Splice Identity))
-> (Int, [Block]) -> Splices (Splice Identity)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (RenderCtx -> Int -> [Block] -> Splices (Splice Identity)
footnoteSplices RenderCtx
ctx)) ((Int, [Block]) -> Splice Identity)
-> [(Int, [Block])] -> Splice Identity
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 Meta
forall a. Monoid a => a
mempty ([Block] -> Pandoc) -> [Block] -> Pandoc
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).
          OneItem [Block] -> [Block]
forall x. One x => OneItem x -> x
one (OneItem [Block] -> [Block]) -> OneItem [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
B.Plain [Inline]
is
        [Block]
_ ->
          [Block]
bs
  Text
"footnote:idx" Text -> Splice Identity -> Splices (Splice Identity)
forall k v. k -> v -> MapSyntax k v
## Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
idx)
  Text
"footnote:content" Text -> Splice Identity -> Splices (Splice Identity)
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 <- Inline -> Maybe Inline
forall a. a -> Maybe a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Inline
inline
  let idx :: Int
idx = HasCallStack => [Block] -> [[Block]] -> Int
[Block] -> [[Block]] -> Int
lookupFootnote [Block]
bs [[Block]]
footnotes
  Node
renderNode <- (NonEmpty Node -> Node) -> Template -> Maybe Node
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty Node -> Node
forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head (Template -> Maybe Node) -> Template -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Template -> (Node -> Template) -> Maybe Node -> Template
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Node -> Template
X.childElementsTag Text
"Note:Ref") (RenderCtx -> Maybe Node
rootNode RenderCtx
ctx)
  Splice Identity -> Maybe (Splice Identity)
forall a. a -> Maybe a
Just (Splice Identity -> Maybe (Splice Identity))
-> Splice Identity -> Maybe (Splice Identity)
forall a b. (a -> b) -> a -> b
$
    Node -> Splices (Splice Identity) -> Splice Identity
runCustomNode Node
renderNode (Splices (Splice Identity) -> Splice Identity)
-> Splices (Splice Identity) -> Splice Identity
forall a b. (a -> b) -> a -> b
$
      RenderCtx -> Int -> [Block] -> Splices (Splice Identity)
footnoteSplices RenderCtx
ctx Int
idx [Block]
bs