    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Commonmark.Extensions.Footnote
      ( footnoteSpec
      , HasFootnote(..)
      )
    where
    import Commonmark.Tokens
    import Commonmark.Types
    import Commonmark.Html
    import Commonmark.Syntax
    import Commonmark.Blocks
    import Commonmark.Inlines
    import Commonmark.SourceMap
    import Commonmark.TokParsers
    import Commonmark.ReferenceMap
    import Control.Monad.Trans.Class (lift)
    import Control.Monad (mzero)
    import Data.List
    import Data.Maybe (fromMaybe, mapMaybe)
    import Data.Dynamic
    import Data.Tree
    import Text.Parsec
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Map as M

    data FootnoteDef bl m =
      FootnoteDef Int Text (ReferenceMap -> m (Either ParseError bl))
      deriving Typeable

    instance Eq (FootnoteDef bl m) where
      FootnoteDef Int
    num1 Text
    lab1 ReferenceMap -> m (Either ParseError bl)
    _ == :: FootnoteDef bl m -> FootnoteDef bl m -> Bool
    == FootnoteDef Int
    num2 Text
    lab2 ReferenceMap -> m (Either ParseError bl)
    _
        = Int
    num1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    num2 Bool -> Bool -> Bool
    && Text
    lab1 Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    lab2

    instance Ord (FootnoteDef bl m) where
      (FootnoteDef Int
    num1 Text
    lab1 ReferenceMap -> m (Either ParseError bl)
    _) compare :: FootnoteDef bl m -> FootnoteDef bl m -> Ordering
    `compare` (FootnoteDef Int
    num2 Text
    lab2 ReferenceMap -> m (Either ParseError bl)
    _) =
        (Int
    num1, Text
    lab1) (Int, Text) -> (Int, Text) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` (Int
    num2, Text
    lab2)

    footnoteSpec :: (Monad m, Typeable m, IsBlock il bl, IsInline il,
                     Typeable il, Typeable bl, HasFootnote il bl)
                 => SyntaxSpec m il bl
    footnoteSpec :: forall (m :: * -> *) il bl.
    (Monad m, Typeable m, IsBlock il bl, IsInline il, Typeable il,
     Typeable bl, HasFootnote il bl) =>
    SyntaxSpec m il bl
    footnoteSpec = SyntaxSpec (ZonkAny 0) il (ZonkAny 1)
    forall a. Monoid a => a
    mempty
      { syntaxBlockSpecs = [footnoteBlockSpec]
      , syntaxInlineParsers = [withAttributes pFootnoteRef]
      , syntaxFinalParsers = [addFootnoteList]
      }

    footnoteBlockSpec :: (Monad m, Typeable m, Typeable il, Typeable bl,
                          IsBlock il bl, IsInline il, HasFootnote il bl)
                      => BlockSpec m il bl
    footnoteBlockSpec :: forall (m :: * -> *) il bl.
    (Monad m, Typeable m, Typeable il, Typeable bl, IsBlock il bl,
     IsInline il, HasFootnote il bl) =>
    BlockSpec m il bl
    footnoteBlockSpec = BlockSpec
         { blockType :: Text
    blockType           = Text
    "Footnote"
         , blockStart :: BlockParser m il bl BlockStartResult
    blockStart          = BlockParser m il bl BlockStartResult
    -> BlockParser m il bl BlockStartResult
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (BlockParser m il bl BlockStartResult
     -> BlockParser m il bl BlockStartResult)
    -> BlockParser m il bl BlockStartResult
    -> BlockParser m il bl BlockStartResult
    forall a b. (a -> b) -> a -> b
    $ do
                 ParsecT [Tok] (BPState m il bl) m ()
    forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
    nonindentSpaces
                 pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
                 lab' <- pFootnoteLabel
                 _ <- symbol ':'
                 counters' <- counters <$> getState
                 let num = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (Int
    1 :: Int) (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $
                           Text -> Map Text Dynamic -> Maybe Dynamic
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    "footnote" Map Text Dynamic
    counters' Maybe Dynamic -> (Dynamic -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Dynamic -> Maybe Int
    forall a. Typeable a => Dynamic -> Maybe a
    fromDynamic
                 updateState $ \BPState m il bl
    s -> BPState m il bl
    s{ counters =
                                         M.insert "footnote" (toDyn (num + 1))
                                          (counters s) }
                 addNodeToStack $
                    Node (defBlockData footnoteBlockSpec){
                                blockData = toDyn (num, lab')
                              , blockStartPos = [pos] } []
                 return BlockStartMatch
         , blockCanContain :: BlockSpec m il bl -> Bool
    blockCanContain     = Bool -> BlockSpec m il bl -> Bool
    forall a b. a -> b -> a
    const Bool
    True
         , blockContainsLines :: Bool
    blockContainsLines  = Bool
    False
         , blockParagraph :: Bool
    blockParagraph      = Bool
    False
         , blockContinue :: BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl)
    blockContinue       = \BlockNode m il bl
    n -> BlockParser m il bl (SourcePos, BlockNode m il bl)
    -> BlockParser m il bl (SourcePos, BlockNode m il bl)
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (BlockParser m il bl (SourcePos, BlockNode m il bl)
     -> BlockParser m il bl (SourcePos, BlockNode m il bl))
    -> BlockParser m il bl (SourcePos, BlockNode m il bl)
    -> BlockParser m il bl (SourcePos, BlockNode m il bl)
    forall a b. (a -> b) -> a -> b
    $ do
                 () ()
    -> ParsecT [Tok] (BPState m il bl) m Int
    -> ParsecT [Tok] (BPState m il bl) m ()
    forall a b.
    a
    -> ParsecT [Tok] (BPState m il bl) m b
    -> ParsecT [Tok] (BPState m il bl) m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Int -> ParsecT [Tok] (BPState m il bl) m Int
    forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
    gobbleSpaces Int
    4)
                   ParsecT [Tok] (BPState m il bl) m ()
    -> ParsecT [Tok] (BPState m il bl) m ()
    -> ParsecT [Tok] (BPState m il bl) m ()
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> ((Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
    forall (m :: * -> *) u.
    Monad m =>
    (Tok -> Bool) -> ParsecT [Tok] u m ()
    skipWhile (TokType -> Tok -> Bool
    hasType TokType
    Spaces) ParsecT [Tok] (BPState m il bl) m ()
    -> ParsecT [Tok] (BPState m il bl) m ()
    -> ParsecT [Tok] (BPState m il bl) m ()
    forall a b.
    ParsecT [Tok] (BPState m il bl) m a
    -> ParsecT [Tok] (BPState m il bl) m b
    -> ParsecT [Tok] (BPState m il bl) m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () ()
    -> ParsecT [Tok] (BPState m il bl) m Tok
    -> ParsecT [Tok] (BPState m il bl) m ()
    forall a b.
    a
    -> ParsecT [Tok] (BPState m il bl) m b
    -> ParsecT [Tok] (BPState m il bl) m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ParsecT [Tok] (BPState m il bl) m Tok
    -> ParsecT [Tok] (BPState m il bl) m Tok
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m a
    lookAhead ParsecT [Tok] (BPState m il bl) m Tok
    forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
    lineEnd)
                 pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
                 return $! (pos, n)
         , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
    blockConstructor    = \BlockNode m il bl
    node ->
              [bl] -> bl
    forall a. Monoid a => [a] -> a
    mconcat ([bl] -> bl)
    -> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (BlockNode m il bl -> BlockParser m il bl bl)
    -> [BlockNode m il bl] -> ParsecT [Tok] (BPState m il bl) m [bl]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\BlockNode m il bl
    n ->
                  BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
    forall (m :: * -> *) il bl.
    BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
    blockConstructor (BlockData m il bl -> BlockSpec m il bl
    forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
    blockSpec (BlockNode m il bl -> BlockData m il bl
    forall a. Tree a -> a
    rootLabel BlockNode m il bl
    n)) BlockNode m il bl
    n)
               (BlockNode m il bl -> [BlockNode m il bl]
    forall a. Tree a -> [Tree a]
    subForest (BlockNode m il bl -> BlockNode m il bl
    forall a. Tree a -> Tree a
    reverseSubforests BlockNode m il bl
    node))
         , blockFinalize :: BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
    blockFinalize       = \(Node BlockData m il bl
    root [BlockNode m il bl]
    children) BlockNode m il bl
    parent -> do
             let (Int
    num, Text
    lab') = Dynamic -> (Int, Text) -> (Int, Text)
    forall a. Typeable a => Dynamic -> a -> a
    fromDyn (BlockData m il bl -> Dynamic
    forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
    blockData BlockData m il bl
    root) (Int
    1, Text
    forall a. Monoid a => a
    mempty)
             st <- ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
    forall (m :: * -> *) s u. Monad m => ParsecT s u m u
    getState
             let mkNoteContents ReferenceMap
    refmap =
                   BlockParser m il bl bl
    -> BPState m il bl -> String -> [Tok] -> m (Either ParseError bl)
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
    runParserT
                     (BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
    forall (m :: * -> *) il bl.
    BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
    blockConstructor (BlockData m il bl -> BlockSpec m il bl
    forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
    blockSpec BlockData m il bl
    root) (BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
    forall a. a -> [Tree a] -> Tree a
    Node BlockData m il bl
    root [BlockNode m il bl]
    children))
                     BPState m il bl
    st{ referenceMap = refmap }
                     String
    "source" []
             updateState $ \BPState m il bl
    s -> BPState m il bl
    s{
                 referenceMap = insertReference lab'
                                  (FootnoteDef num lab' mkNoteContents)
                                  (referenceMap s)
                 }
             return $! parent
         }

    pFootnoteLabel :: Monad m => ParsecT [Tok] u m Text
    pFootnoteLabel :: forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Text
    pFootnoteLabel = ParsecT [Tok] u m Text -> ParsecT [Tok] u m Text
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tok] u m Text -> ParsecT [Tok] u m Text)
    -> ParsecT [Tok] u m Text -> ParsecT [Tok] u m Text
    forall a b. (a -> b) -> a -> b
    $ do
      lab <- [Tok] -> Text
    untokenize
          ([Tok] -> Text)
    -> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m [Tok]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tok] u m Tok
    -> ParsecT [Tok] u m Tok
    -> ParsecT [Tok] u m [Tok]
    -> ParsecT [Tok] u m [Tok]
    forall s (m :: * -> *) t u open close a.
    Stream s m t =>
    ParsecT s u m open
    -> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
    between (Char -> ParsecT [Tok] u m Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '[') (Char -> ParsecT [Tok] u m Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    ']')
                (([Tok], [Tok]) -> [Tok]
    forall a b. (a, b) -> b
    snd (([Tok], [Tok]) -> [Tok])
    -> ParsecT [Tok] u m ([Tok], [Tok]) -> ParsecT [Tok] u m [Tok]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m ([Tok], [Tok])
    forall (m :: * -> *) s a.
    Monad m =>
    ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
    withRaw (ParsecT [Tok] u m Tok -> ParsecT [Tok] u m [Tok]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many
                  (ParsecT [Tok] u m Tok
    forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
    pEscaped ParsecT [Tok] u m Tok
    -> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> [TokType] -> ParsecT [Tok] u m Tok
    forall (m :: * -> *) s.
    Monad m =>
    [TokType] -> ParsecT [Tok] s m Tok
    noneOfToks [Char -> TokType
    Symbol Char
    ']', Char -> TokType
    Symbol Char
    '[', TokType
    LineEnd]))))
      case T.uncons lab of
            Just (Char
    '^', Text
    t') | (Char -> Bool) -> Text -> Bool
    T.any (\Char
    x -> Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ' Bool -> Bool -> Bool
    && Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\t') Text
    t' Bool -> Bool -> Bool
    && (Char -> Bool) -> Text -> Bool
    T.all (\Char
    x -> Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n' Bool -> Bool -> Bool
    && Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\r') Text
    t'
                -> Text -> ParsecT [Tok] u m Text
    forall a. a -> ParsecT [Tok] u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> ParsecT [Tok] u m Text) -> Text -> ParsecT [Tok] u m Text
    forall a b. (a -> b) -> a -> b
    $! Text
    t'
            Maybe (Char, Text)
    _ -> ParsecT [Tok] u m Text
    forall a. ParsecT [Tok] u m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    pFootnoteRef :: (Monad m, Typeable m, Typeable a,
                     Typeable b, IsInline a, IsBlock a b, HasFootnote a b)
                 => InlineParser m a
    pFootnoteRef :: forall (m :: * -> *) a b.
    (Monad m, Typeable m, Typeable a, Typeable b, IsInline a,
     IsBlock a b, HasFootnote a b) =>
    InlineParser m a
    pFootnoteRef = ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT [Tok] (IPState m) (StateT Enders m) a
     -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a b. (a -> b) -> a -> b
    $ do
      lab <- ParsecT [Tok] (IPState m) (StateT Enders m) Text
    forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Text
    pFootnoteLabel
      rm <- getReferenceMap
      case lookupReference lab rm of
            Just (FootnoteDef Int
    num Text
    _ ReferenceMap -> m (Either ParseError b)
    mkContents) -> do
              res <- StateT Enders m (Either ParseError b)
    -> ParsecT
         [Tok] (IPState m) (StateT Enders m) (Either ParseError b)
    forall (m :: * -> *) a.
    Monad m =>
    m a -> ParsecT [Tok] (IPState m) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT Enders m (Either ParseError b)
     -> ParsecT
          [Tok] (IPState m) (StateT Enders m) (Either ParseError b))
    -> (m (Either ParseError b)
        -> StateT Enders m (Either ParseError b))
    -> m (Either ParseError b)
    -> ParsecT
         [Tok] (IPState m) (StateT Enders m) (Either ParseError b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m (Either ParseError b) -> StateT Enders m (Either ParseError b)
    forall (m :: * -> *) a. Monad m => m a -> StateT Enders m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m (Either ParseError b)
     -> ParsecT
          [Tok] (IPState m) (StateT Enders m) (Either ParseError b))
    -> m (Either ParseError b)
    -> ParsecT
         [Tok] (IPState m) (StateT Enders m) (Either ParseError b)
    forall a b. (a -> b) -> a -> b
    $ ReferenceMap -> m (Either ParseError b)
    mkContents ReferenceMap
    rm
              case res of
                   Left ParseError
    err -> (State [Tok] (IPState m)
     -> StateT
          Enders m (Consumed (StateT Enders m (Reply [Tok] (IPState m) a))))
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall (m :: * -> *) s u a.
    Monad m =>
    (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
    mkPT (\State [Tok] (IPState m)
    _ -> Consumed (StateT Enders m (Reply [Tok] (IPState m) a))
    -> StateT
         Enders m (Consumed (StateT Enders m (Reply [Tok] (IPState m) a)))
    forall a. a -> StateT Enders m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StateT Enders m (Reply [Tok] (IPState m) a)
    -> Consumed (StateT Enders m (Reply [Tok] (IPState m) a))
    forall a. a -> Consumed a
    Empty (Reply [Tok] (IPState m) a
    -> StateT Enders m (Reply [Tok] (IPState m) a)
    forall a. a -> StateT Enders m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ParseError -> Reply [Tok] (IPState m) a
    forall s u a. ParseError -> Reply s u a
    Error ParseError
    err))))
                   Right b
    contents -> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
    -> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a b. (a -> b) -> a -> b
    $!
                     Text -> Text -> b -> a
    forall il bl. HasFootnote il bl => Text -> Text -> bl -> il
    footnoteRef (String -> Text
    T.pack (Int -> String
    forall a. Show a => a -> String
    show Int
    num)) Text
    lab b
    contents
            Maybe (FootnoteDef b m)
    Nothing -> ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall a. ParsecT [Tok] (IPState m) (StateT Enders m) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    addFootnoteList :: (Monad m, Typeable m, Typeable bl, HasFootnote il bl,
                        IsBlock il bl) => BlockParser m il bl bl
    addFootnoteList :: forall (m :: * -> *) bl il.
    (Monad m, Typeable m, Typeable bl, HasFootnote il bl,
     IsBlock il bl) =>
    BlockParser m il bl bl
    addFootnoteList = do
      rm <- BPState m il bl -> ReferenceMap
    forall (m :: * -> *) il bl. BPState m il bl -> ReferenceMap
    referenceMap (BPState m il bl -> ReferenceMap)
    -> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
    -> ParsecT [Tok] (BPState m il bl) m ReferenceMap
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
    forall (m :: * -> *) s u. Monad m => ParsecT s u m u
    getState
      let keys = Map Text [Dynamic] -> [Text]
    forall k a. Map k a -> [k]
    M.keys (Map Text [Dynamic] -> [Text])
    -> (ReferenceMap -> Map Text [Dynamic]) -> ReferenceMap -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ReferenceMap -> Map Text [Dynamic]
    unReferenceMap (ReferenceMap -> [Text]) -> ReferenceMap -> [Text]
    forall a b. (a -> b) -> a -> b
    $ ReferenceMap
    rm
      let getNote Text
    key = Text -> ReferenceMap -> Maybe a
    forall a. Typeable a => Text -> ReferenceMap -> Maybe a
    lookupReference Text
    key ReferenceMap
    rm
      let notes = [FootnoteDef bl m] -> [FootnoteDef bl m]
    forall a. Ord a => [a] -> [a]
    sort ([FootnoteDef bl m] -> [FootnoteDef bl m])
    -> [FootnoteDef bl m] -> [FootnoteDef bl m]
    forall a b. (a -> b) -> a -> b
    $ (Text -> Maybe (FootnoteDef bl m)) -> [Text] -> [FootnoteDef bl m]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Text -> Maybe (FootnoteDef bl m)
    forall {a}. Typeable a => Text -> Maybe a
    getNote [Text]
    keys
      let renderNote (FootnoteDef Int
    num Text
    lab ReferenceMap -> m (Either ParseError b)
    mkContents) = do
            res <- m (Either ParseError b) -> ParsecT s u m (Either ParseError b)
    forall (m :: * -> *) a. Monad m => m a -> ParsecT s u m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m (Either ParseError b) -> ParsecT s u m (Either ParseError b))
    -> m (Either ParseError b) -> ParsecT s u m (Either ParseError b)
    forall a b. (a -> b) -> a -> b
    $ ReferenceMap -> m (Either ParseError b)
    mkContents ReferenceMap
    rm
            case res of
                 Left ParseError
    err -> (State s u -> m (Consumed (m (Reply s u b)))) -> ParsecT s u m b
    forall (m :: * -> *) s u a.
    Monad m =>
    (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
    mkPT (\State s u
    _ -> Consumed (m (Reply s u b)) -> m (Consumed (m (Reply s u b)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (m (Reply s u b) -> Consumed (m (Reply s u b))
    forall a. a -> Consumed a
    Empty (Reply s u b -> m (Reply s u b)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ParseError -> Reply s u b
    forall s u a. ParseError -> Reply s u a
    Error ParseError
    err))))
                 Right b
    contents -> b -> ParsecT s u m b
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> ParsecT s u m b) -> b -> ParsecT s u m b
    forall a b. (a -> b) -> a -> b
    $! Int -> Text -> b -> b
    forall il bl. HasFootnote il bl => Int -> Text -> bl -> bl
    footnote Int
    num Text
    lab b
    contents
      if null notes
         then return mempty
         else footnoteList <$> mapM renderNote notes

    class IsBlock il bl => HasFootnote il bl | il -> bl where
      footnote :: Int -> Text -> bl -> bl
      footnoteList :: [bl] -> bl
      footnoteRef :: Text -> Text -> bl -> il

    instance Rangeable (Html a) => HasFootnote (Html a) (Html a) where
      footnote :: Int -> Text -> Html a -> Html a
    footnote Int
    num Text
    lab' Html a
    x =
        Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "class", Text
    "footnote") (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
        Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "id", Text
    "fn-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    lab') (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
        Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "div" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
    forall a b. (a -> b) -> a -> b
    $ Text -> Html a
    forall a. Text -> Html a
    htmlRaw Text
    "\n" Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <>
          (Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "class", Text
    "footnote-number") (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
           Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "div" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
    forall a b. (a -> b) -> a -> b
    $ Text -> Html a
    forall a. Text -> Html a
    htmlRaw Text
    "\n" Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <>
            (Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "href", Text
    "#fnref-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    lab') (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
             Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "a" (Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
    forall a b. (a -> b) -> a -> b
    $ Text -> Html a
    forall a. Text -> Html a
    htmlText (Text -> Html a) -> Text -> Html a
    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
    num)) Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <>
             Text -> Html a
    forall a. Text -> Html a
    htmlRaw Text
    "\n") Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <>
          (Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "class", Text
    "footnote-contents") (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
            Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "div" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
    forall a b. (a -> b) -> a -> b
    $ Text -> Html a
    forall a. Text -> Html a
    htmlRaw Text
    "\n" Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> Html a
    x)
      footnoteList :: [Html a] -> Html a
    footnoteList [Html a]
    items =
        Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "class", Text
    "footnotes") (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
          Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlBlock Text
    "section" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
    forall a b. (a -> b) -> a -> b
    $ Text -> Html a
    forall a. Text -> Html a
    htmlRaw Text
    "\n" Html a -> Html a -> Html a
    forall a. Semigroup a => a -> a -> a
    <> [Html a] -> Html a
    forall a. Monoid a => [a] -> a
    mconcat [Html a]
    items
      footnoteRef :: Text -> Text -> Html a -> Html a
    footnoteRef Text
    x Text
    lab Html a
    _ =
       Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "class", Text
    "footnote-ref") (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
         Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "sup" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
    forall a b. (a -> b) -> a -> b
    $
           Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "href", Text
    "#fn-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    lab) (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
           Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "id", Text
    "fnref-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    lab) (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
           Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "a" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
    forall a b. (a -> b) -> a -> b
    $ Html a -> Maybe (Html a)
    forall a. a -> Maybe a
    Just (Text -> Html a
    forall a. Text -> Html a
    htmlText Text
    x)

    instance (HasFootnote il bl, Semigroup bl, Semigroup il)
            => HasFootnote (WithSourceMap il) (WithSourceMap bl) where
      footnote :: Int -> Text -> WithSourceMap bl -> WithSourceMap bl
    footnote Int
    num Text
    lab' WithSourceMap bl
    x = (Int -> Text -> bl -> bl
    forall il bl. HasFootnote il bl => Int -> Text -> bl -> bl
    footnote Int
    num Text
    lab' (bl -> bl) -> WithSourceMap bl -> WithSourceMap bl
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WithSourceMap bl
    x) WithSourceMap bl -> WithSourceMap () -> WithSourceMap bl
    forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Text -> WithSourceMap ()
    addName Text
    "footnote"
      footnoteList :: [WithSourceMap bl] -> WithSourceMap bl
    footnoteList [WithSourceMap bl]
    items = [bl] -> bl
    forall il bl. HasFootnote il bl => [bl] -> bl
    footnoteList ([bl] -> bl) -> WithSourceMap [bl] -> WithSourceMap bl
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [WithSourceMap bl] -> WithSourceMap [bl]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [WithSourceMap bl]
    items
      footnoteRef :: Text -> Text -> WithSourceMap bl -> WithSourceMap il
    footnoteRef Text
    x Text
    y WithSourceMap bl
    z = (Text -> Text -> bl -> il
    forall il bl. HasFootnote il bl => Text -> Text -> bl -> il
    footnoteRef Text
    x Text
    y (bl -> il) -> WithSourceMap bl -> WithSourceMap il
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WithSourceMap bl
    z) WithSourceMap il -> WithSourceMap () -> WithSourceMap il
    forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Text -> WithSourceMap ()
    addName Text
    "footnoteRef"