{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Text.MMark.Extension.Footnotes
( footnotes )
where
import Control.Monad
import Data.Char (isDigit)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Semigroup ((<>))
import Data.Text (Text)
import Lens.Micro ((^.))
import Lucid
import Text.MMark.Extension (Extension, Inline (..), Block (..), getOis)
import Text.URI.Lens (uriPath)
import Text.URI.QQ (scheme)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Text.MMark.Extension as Ext
import qualified Text.URI as URI
footnotes :: Extension
footnotes = footnoteRefs <> footnoteSection
footnoteRefs :: Extension
footnoteRefs = Ext.inlineRender $ \old inline ->
case inline of
l@(Link _ uri _) ->
if URI.uriScheme uri == Just [scheme|footnote|]
then case uri ^. uriPath of
[x'] ->
let x = URI.unRText x'
in if T.all isDigit x
then a_ [ fragmentHref (footnoteId x)
, id_ (referenceId x) ] $
sup_ (toHtml x)
else old l
_ -> old l
else old l
other -> old other
footnoteSection :: Extension
footnoteSection = Ext.blockRender $ \old block ->
case block of
b@(Blockquote [Paragraph (pOis, _), OrderedList i items]) ->
if getOis pOis == Plain "footnotes" :| []
then do let startIndex = [start_ (renderIx i) | i /= 1]
renderIx = T.pack . show
ol_ startIndex $ do
newline
forM_ (NE.zip (NE.iterate (+ 1) i) items) $ \(j, x) -> do
let j' = renderIx j
li_ [id_ (footnoteId j')] $ do
newline
mapM_ old x
a_ [fragmentHref (referenceId j')] "↩"
newline
newline
else old b
other -> old other
where
newline = "\n"
fragmentHref :: Text -> Attribute
fragmentHref = href_ . URI.render . Ext.headerFragment
footnoteId :: Text -> Text
footnoteId x = "fn" <> x
referenceId :: Text -> Text
referenceId x = "fnref" <> x