content: {-# 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 = 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 = do
    nodes <- nodeStack <$> getState
    mapM_ (traverse addHeadingRef) nodes
    return mempty
  
  addHeadingRef :: (Monad m, IsBlock il bl, IsInline il)
               => BlockData m il bl -> BlockParser m il bl ()
  addHeadingRef bd
    | blockType (blockSpec bd) `elem` ["ATXHeading", "SetextHeading"] = do
        -- update ref map
        let lab = untokenize . removeIndent . mconcat . reverse . blockLines $ bd
        let ident = fromMaybe "" $ lookup "id" $ blockAttributes bd
        unless (T.null lab) $
          updateState $ \s -> s{
            referenceMap = insertReference lab
              LinkInfo{ linkDestination = "#" <> ident
                      , linkTitle = mempty
                      , linkAttributes = mempty
                      , linkPos = Nothing }
              (referenceMap s) }
    | otherwise = return ()
  