{-# LANGUAGE CPP #-}
{-# 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
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
implicitHeadingReferencesSpec
:: (Monad m, IsBlock il bl, IsInline il)
=> SyntaxSpec m il bl
implicitHeadingReferencesSpec = mempty
{ syntaxFinalParsers = [addHeadingReferences]
}
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
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 }
(referenceMap s) }
| otherwise = return ()