From 07e8cedf2bddcbf13bfd69a415107b2a9aa074aa Mon Sep 17 00:00:00 2001
From: John MacFarlane <fiddlosopher@gmail.com>
Date: Thu, 21 Feb 2013 19:53:35 -0800
Subject: Make `implicit_header_references` work with explicit header ids.

(Markdown reader.)
---
 src/Text/Pandoc/Parsing.hs          |  4 ++--
 src/Text/Pandoc/Readers/Markdown.hs | 39 ++++++++++++++++++++++---------------
 2 files changed, 25 insertions(+), 18 deletions(-)

(limited to 'src/Text/Pandoc')

diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 0bb609e5d..44a64c80a 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -794,7 +794,7 @@ data ParserState = ParserState
       stateAuthors         :: [[Inline]],    -- ^ Authors of document
       stateDate            :: [Inline],      -- ^ Date of document
       stateHeaderTable     :: [HeaderType],  -- ^ Ordered list of header types used
-      stateHeaders         :: [[Inline]],    -- ^ List of headers (used for implicit ref links)
+      stateHeaders         :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links)
       stateIdentifiers     :: [String],      -- ^ List of header identifiers used
       stateNextExample     :: Int,           -- ^ Number of next example
       stateExamples        :: M.Map String Int, -- ^ Map from example labels to numbers
@@ -823,7 +823,7 @@ defaultParserState =
                   stateAuthors         = [],
                   stateDate            = [],
                   stateHeaderTable     = [],
-                  stateHeaders         = [],
+                  stateHeaders         = M.empty,
                   stateIdentifiers     = [],
                   stateNextExample     = 1,
                   stateExamples        = M.empty,
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index e037c0897..29eac02bf 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -390,15 +390,22 @@ header = setextHeader <|> atxHeader <?> "header"
 --  returns unique identifier
 addToHeaderList :: Attr -> F Inlines -> MarkdownParser Attr
 addToHeaderList (ident,classes,kvs) text = do
-  let headerList = B.toList $ runF text defaultParserState
-  updateState $ \st -> st{ stateHeaders = headerList : stateHeaders st }
-  (do guardEnabled Ext_auto_identifiers
-      ids <- stateIdentifiers `fmap` getState
-      let id' = if null ident
-                   then uniqueIdent headerList ids
-                   else ident
-      updateState $ \st -> st{ stateIdentifiers = id' : ids }
-      return (id',classes,kvs)) <|> return ("",classes,kvs)
+  let header' = runF text defaultParserState
+  exts <- getOption readerExtensions
+  let insert' = M.insertWith (\_new old -> old)
+  if null ident && Ext_auto_identifiers `Set.member` exts
+     then do
+       ids <- stateIdentifiers `fmap` getState
+       let id' = uniqueIdent (B.toList header') ids
+       updateState $ \st -> st{
+              stateIdentifiers = id' : ids,
+              stateHeaders = insert' header' id' $ stateHeaders st }
+       return (id',classes,kvs)
+     else do
+        unless (null ident) $
+          updateState $ \st -> st{
+               stateHeaders = insert' header' ident $ stateHeaders st }
+        return (ident,classes,kvs)
 
 atxHeader :: MarkdownParser (F Blocks)
 atxHeader = try $ do
@@ -1539,13 +1546,13 @@ referenceLink constructor (lab, raw) = do
     case M.lookup key keys of
        Nothing        -> do
          headers <- asksF stateHeaders
-         let ref' = B.toList $ runF (if labIsRef then lab else ref)
-                               defaultParserState
-         if implicitHeaderRefs && ref' `elem` headers
-            then do
-              let src = '#' : uniqueIdent ref' []
-              constructor src "" <$> lab
-            else (\x -> B.str "[" <> x <> B.str "]" <> B.str raw') <$> fallback
+         let ref' = runF (if labIsRef then lab else ref) defaultParserState
+         let makeFallback x = B.str "[" <> x <> B.str "]" <> B.str raw'
+         if implicitHeaderRefs
+            then case M.lookup ref' headers of
+                   Just ident -> constructor ('#':ident) "" <$> lab
+                   Nothing    -> makeFallback <$> fallback
+            else makeFallback <$> fallback
        Just (src,tit) -> constructor src tit <$> lab
 
 bareURL :: MarkdownParser (F Inlines)
-- 
cgit v1.2.3