    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE LambdaCase #-}
    module Commonmark.Extensions.ImplicitHeadingReferences
      ( implicitHeadingReferencesSpec
      )
    where
    import Commonmark.Types
    import Commonmark.Tokens
    import Commonmark.Syntax
    import Commonmark.Blocks
    import Commonmark.ReferenceMap
    import qualified Data.Text as T
    import Control.Monad (unless)
    import Data.Maybe (fromMaybe)
    import Text.Parsec

    implicitHeadingReferencesSpec
             :: (Monad m, IsBlock il bl, IsInline il)
             => SyntaxSpec m il bl
    implicitHeadingReferencesSpec :: forall (m :: * -> *) il bl.
    (Monad m, IsBlock il bl, IsInline il) =>
    SyntaxSpec m il bl
    implicitHeadingReferencesSpec = SyntaxSpec m il bl
    forall a. Monoid a => a
    mempty
      { syntaxFinalParsers = [addHeadingReferences]
      }

    -- Go through the node stack and add implicit references
    -- for each header.
    addHeadingReferences :: (Monad m, IsBlock il bl, IsInline il)
                        => BlockParser m il bl bl
    addHeadingReferences :: forall (m :: * -> *) il bl.
    (Monad m, IsBlock il bl, IsInline il) =>
    BlockParser m il bl bl
    addHeadingReferences = do
      nodes <- BPState m il bl -> [BlockNode m il bl]
    forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
    nodeStack (BPState m il bl -> [BlockNode m il bl])
    -> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
    -> ParsecT [Tok] (BPState m il bl) m [BlockNode m il bl]
    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
      mapM_ (traverse addHeadingRef) nodes
      return mempty

    addHeadingRef :: (Monad m, IsBlock il bl, IsInline il)
                 => BlockData m il bl -> BlockParser m il bl ()
    addHeadingRef :: forall (m :: * -> *) il bl.
    (Monad m, IsBlock il bl, IsInline il) =>
    BlockData m il bl -> BlockParser m il bl ()
    addHeadingRef BlockData m il bl
    bd
      | BlockSpec m il bl -> Text
    forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
    blockType (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
    bd) Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text
    "ATXHeading", Text
    "SetextHeading"] = do
          -- update ref map
          let lab :: Text
    lab = [Tok] -> Text
    untokenize ([Tok] -> Text)
    -> (BlockData m il bl -> [Tok]) -> BlockData m il bl -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Tok] -> [Tok]
    removeIndent ([Tok] -> [Tok])
    -> (BlockData m il bl -> [Tok]) -> BlockData m il bl -> [Tok]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Tok]] -> [Tok]
    forall a. Monoid a => [a] -> a
    mconcat ([[Tok]] -> [Tok])
    -> (BlockData m il bl -> [[Tok]]) -> BlockData m il bl -> [Tok]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Tok]] -> [[Tok]]
    forall a. [a] -> [a]
    reverse ([[Tok]] -> [[Tok]])
    -> (BlockData m il bl -> [[Tok]]) -> BlockData m il bl -> [[Tok]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlockData m il bl -> [[Tok]]
    forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
    blockLines (BlockData m il bl -> Text) -> BlockData m il bl -> Text
    forall a b. (a -> b) -> a -> b
    $ BlockData m il bl
    bd
          let ident :: Text
    ident = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Attributes -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "id" (Attributes -> Maybe Text) -> Attributes -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ BlockData m il bl -> Attributes
    forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
    blockAttributes BlockData m il bl
    bd
          Bool
    -> ParsecT [Tok] (BPState m il bl) m ()
    -> ParsecT [Tok] (BPState m il bl) m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text -> Bool
    T.null Text
    lab) (ParsecT [Tok] (BPState m il bl) m ()
     -> ParsecT [Tok] (BPState m il bl) m ())
    -> ParsecT [Tok] (BPState m il bl) m ()
    -> ParsecT [Tok] (BPState m il bl) m ()
    forall a b. (a -> b) -> a -> b
    $
            (BPState m il bl -> BPState m il bl)
    -> ParsecT [Tok] (BPState m il bl) m ()
    forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
    updateState ((BPState m il bl -> BPState m il bl)
     -> ParsecT [Tok] (BPState m il bl) m ())
    -> (BPState m il bl -> BPState m il bl)
    -> ParsecT [Tok] (BPState m il bl) m ()
    forall a b. (a -> b) -> a -> b
    $ \BPState m il bl
    s -> BPState m il bl
    s{
              referenceMap = insertReference lab
                LinkInfo{ linkDestination = "#" <> ident
                        , linkTitle = mempty
                        , linkAttributes = mempty
                        , linkPos = Nothing }
                (referenceMap s) }
      | Bool
    otherwise = () -> ParsecT [Tok] (BPState m il bl) m ()
    forall a. a -> ParsecT [Tok] (BPState m il bl) m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()