{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Reflex.Dom.Pandoc.Footnotes where
import Control.Monad.Reader
import Data.List (nub, sortOn)
import Data.Map (Map)
import Data.Text (Text)
import qualified Data.Map as Map
import qualified Data.Text as T
import Reflex.Dom.Core hiding (Link, Space)
import Text.Pandoc.Definition
import Text.Pandoc.Walk
newtype = { :: [Block]}
deriving (Footnote -> Footnote -> Bool
(Footnote -> Footnote -> Bool)
-> (Footnote -> Footnote -> Bool) -> Eq Footnote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Footnote -> Footnote -> Bool
$c/= :: Footnote -> Footnote -> Bool
== :: Footnote -> Footnote -> Bool
$c== :: Footnote -> Footnote -> Bool
Eq, Int -> Footnote -> ShowS
[Footnote] -> ShowS
Footnote -> String
(Int -> Footnote -> ShowS)
-> (Footnote -> String) -> ([Footnote] -> ShowS) -> Show Footnote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Footnote] -> ShowS
$cshowList :: [Footnote] -> ShowS
show :: Footnote -> String
$cshow :: Footnote -> String
showsPrec :: Int -> Footnote -> ShowS
$cshowsPrec :: Int -> Footnote -> ShowS
Show, Eq Footnote
Eq Footnote
-> (Footnote -> Footnote -> Ordering)
-> (Footnote -> Footnote -> Bool)
-> (Footnote -> Footnote -> Bool)
-> (Footnote -> Footnote -> Bool)
-> (Footnote -> Footnote -> Bool)
-> (Footnote -> Footnote -> Footnote)
-> (Footnote -> Footnote -> Footnote)
-> Ord Footnote
Footnote -> Footnote -> Bool
Footnote -> Footnote -> Ordering
Footnote -> Footnote -> Footnote
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Footnote -> Footnote -> Footnote
$cmin :: Footnote -> Footnote -> Footnote
max :: Footnote -> Footnote -> Footnote
$cmax :: Footnote -> Footnote -> Footnote
>= :: Footnote -> Footnote -> Bool
$c>= :: Footnote -> Footnote -> Bool
> :: Footnote -> Footnote -> Bool
$c> :: Footnote -> Footnote -> Bool
<= :: Footnote -> Footnote -> Bool
$c<= :: Footnote -> Footnote -> Bool
< :: Footnote -> Footnote -> Bool
$c< :: Footnote -> Footnote -> Bool
compare :: Footnote -> Footnote -> Ordering
$ccompare :: Footnote -> Footnote -> Ordering
$cp1Ord :: Eq Footnote
Ord)
type = Map Footnote Int
mkFootnote :: [Block] -> Footnote
[Block]
blocks =
[Block] -> Footnote
Footnote [Block]
blocks
queryFootnotes :: Pandoc -> Footnotes
=
[Footnote] -> Footnotes
buildFootnotes
([Footnote] -> Footnotes)
-> (Pandoc -> [Footnote]) -> Pandoc -> Footnotes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> [Footnote]) -> Pandoc -> [Footnote]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query
( \case
Note [Block]
xs -> [[Block] -> Footnote
mkFootnote [Block]
xs]
Inline
_ -> []
)
where
buildFootnotes :: [Footnote] -> Footnotes
buildFootnotes :: [Footnote] -> Footnotes
buildFootnotes [Footnote]
fs =
[(Footnote, Int)] -> Footnotes
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Footnote, Int)] -> Footnotes) -> [(Footnote, Int)] -> Footnotes
forall a b. (a -> b) -> a -> b
$
(((Footnote, Int) -> (Footnote, Int))
-> [(Footnote, Int)] -> [(Footnote, Int)])
-> [(Footnote, Int)]
-> ((Footnote, Int) -> (Footnote, Int))
-> [(Footnote, Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Footnote, Int) -> (Footnote, Int))
-> [(Footnote, Int)] -> [(Footnote, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Footnote] -> [Int] -> [(Footnote, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Footnote] -> [Footnote]
forall a. Eq a => [a] -> [a]
nub [Footnote]
fs) [Int
1 ..]) (((Footnote, Int) -> (Footnote, Int)) -> [(Footnote, Int)])
-> ((Footnote, Int) -> (Footnote, Int)) -> [(Footnote, Int)]
forall a b. (a -> b) -> a -> b
$ \(Footnote
fn, Int
idx) ->
(Footnote
fn, Int
idx)
renderFootnotes :: (DomBuilder t m, Monoid a) => ([Block] -> m a) -> Footnotes -> m a
[Block] -> m a
render Footnotes
footnotes = do
if Footnotes -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Footnotes
footnotes
then a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
else do
Text -> Map Text Text -> m a -> m a
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
"div" (Index (Map Text Text)
"id" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map Text Text)
"footnotes") (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ do
Text -> m a -> m a
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"ol" (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$
([a] -> a) -> m [a] -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Monoid a => [a] -> a
mconcat (m [a] -> m a) -> m [a] -> m a
forall a b. (a -> b) -> a -> b
$
[(Footnote, Int)] -> ((Footnote, Int) -> m a) -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (((Footnote, Int) -> Int) -> [(Footnote, Int)] -> [(Footnote, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Footnote, Int) -> Int
forall a b. (a, b) -> b
snd ([(Footnote, Int)] -> [(Footnote, Int)])
-> [(Footnote, Int)] -> [(Footnote, Int)]
forall a b. (a -> b) -> a -> b
$ Footnotes -> [(Footnote, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList Footnotes
footnotes) (((Footnote, Int) -> m a) -> m [a])
-> ((Footnote, Int) -> m a) -> m [a]
forall a b. (a -> b) -> a -> b
$ \(Footnote [Block]
blks, Int
idx) -> do
Text -> Map Text Text -> m a -> m a
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
"li" (Index (Map Text Text)
"id" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (Text
"fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
idx))) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ do
a
x <- [Block] -> m a
render [Block]
blks
Text -> Map Text Text -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
"a" (Index (Map Text Text)
"href" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (Text
"#fnref" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
idx))) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"↩︎"
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
renderFootnoteRef :: DomBuilder t m => Int -> m ()
Int
idx = do
Map Text Text -> m () -> m ()
forall t (m :: * -> *).
DomBuilder t m =>
Map Text Text -> m () -> m ()
elNoSnippetSpan Map Text Text
forall k a. Map k a
Map.empty (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Text -> m a -> m a
elClass Text
"sup" Text
"footnote-ref" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Map Text Text -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
"a" (Index (Map Text Text)
"id" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (Text
"fnref" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
idx)) Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<> Index (Map Text Text)
"href" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (Text
"#fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
idx))) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
idx
where
elNoSnippetSpan :: DomBuilder t m => Map Text Text -> m () -> m ()
elNoSnippetSpan :: Map Text Text -> m () -> m ()
elNoSnippetSpan Map Text Text
attrs = Text -> Map Text Text -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
"span" (Index (Map Text Text)
"data-nosnippet" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map Text Text)
"" Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<> Map Text Text
attrs)
sansFootnotes :: DomBuilder t m => ReaderT Footnotes m a -> m a
= (ReaderT Footnotes m a -> Footnotes -> m a)
-> Footnotes -> ReaderT Footnotes m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Footnotes m a -> Footnotes -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Footnotes
forall a. Monoid a => a
mempty