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 = [[B.Block]]
gatherFootnotes :: Pandoc -> Footnotes
= 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
[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
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"
## (HI.runChildrenWith . uncurry (footnoteSplices ctx)) `foldMapM` footnotesWithIdx
footnoteSplices :: RenderCtx -> Int -> [B.Block] -> H.Splices (HI.Splice Identity)
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] ->
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)
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