Added Attr field to Header.

Previously header ids were autogenerated by the writers.
Now they are generated (unless supplied explicitly) in the
markdown parser, if the `header_identifiers` extension is
selected.

In addition, the textile reader now supports id attributes on
headers.

4 files changed, 31 insertions, 18 deletions

diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 424d9bdec..f4f421cfc 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -160,7 +160,7 @@ fixPlains inList bs = if any isParaish bs
                          else bs
   where isParaish (Para _) = True
         isParaish (CodeBlock _ _) = True
-        isParaish (Header _ _) = True
+        isParaish (Header _ _ _) = True
         isParaish (BlockQuote _) = True
         isParaish (BulletList _) = not inList
         isParaish (OrderedList _ _) = not inList
@@ -201,7 +201,9 @@ pHeader = try $ do
   contents <- liftM concat $ manyTill inline (pCloses tagtype <|> eof)
   return $ if bodyTitle
               then []  -- skip a representation of the title in the body
-              else [Header level $ normalizeSpaces contents]
+              else [Header level (fromAttrib "id" $
+                                  TagOpen tagtype attr, [], []) $
+                    normalizeSpaces contents]
 
 pHrule :: TagParser [Block]
 pHrule = do
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index a3a2334a4..c27ccf6fd 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -372,10 +372,16 @@ block = choice [ codeBlockFenced
 header :: MarkdownParser (F Blocks)
 header = setextHeader <|> atxHeader <?> "header"
 
-addToHeaderList :: F Inlines -> MarkdownParser ()
-addToHeaderList text =
-  updateState $ \st -> st{ stateHeaders = B.toList (runF text defaultParserState)
-                                          : stateHeaders st }
+--  returns unique identifier
+addToHeaderList :: F Inlines -> MarkdownParser String
+addToHeaderList text = do
+  let headerList = B.toList $ runF text defaultParserState
+  updateState $ \st -> st{ stateHeaders = headerList : stateHeaders st }
+  (do guardEnabled Ext_header_identifiers
+      ids <- stateIdentifiers `fmap` getState
+      let id' = uniqueIdent headerList ids
+      updateState $ \st -> st{ stateIdentifiers = id' : ids }
+      return id') <|> return ""
 
 atxHeader :: MarkdownParser (F Blocks)
 atxHeader = try $ do
@@ -383,8 +389,8 @@ atxHeader = try $ do
   notFollowedBy (char '.' <|> char ')') -- this would be a list
   skipSpaces
   text <- trimInlinesF . mconcat <$> manyTill inline atxClosing
-  addToHeaderList text
-  return $ B.header level <$> text
+  id' <- addToHeaderList text
+  return $ B.headerWith (id',[],[]) level <$> text
 
 atxClosing :: Parser [Char] st String
 atxClosing = try $ skipMany (char '#') >> blanklines
@@ -399,8 +405,8 @@ setextHeader = try $ do
   many (char underlineChar)
   blanklines
   let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1
-  addToHeaderList text
-  return $ B.header level <$> text
+  id' <- addToHeaderList text
+  return $ B.headerWith (id',[],[]) level <$> text
 
 --
 -- hrule block
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 60301ad85..cc8293132 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -74,14 +74,14 @@ specialChars = "\\`|*_<>$:/[]{}()-.\"'\8216\8217\8220\8221"
 --
 
 isHeader :: Int -> Block -> Bool
-isHeader n (Header x _) = x == n
-isHeader _ _            = False
+isHeader n (Header x _ _) = x == n
+isHeader _ _              = False
 
 -- | Promote all headers in a list of blocks.  (Part of
 -- title transformation for RST.)
 promoteHeaders :: Int -> [Block] -> [Block]
-promoteHeaders num ((Header level text):rest) =
-    (Header (level - num) text):(promoteHeaders num rest)
+promoteHeaders num ((Header level attr text):rest) =
+    (Header (level - num) attr text):(promoteHeaders num rest)
 promoteHeaders num (other:rest) = other:(promoteHeaders num rest)
 promoteHeaders _   [] = []
 
@@ -90,10 +90,10 @@ promoteHeaders _   [] = []
 -- promote all the other headers.
 titleTransform :: [Block]              -- ^ list of blocks
                -> ([Block], [Inline])  -- ^ modified list of blocks, title
-titleTransform ((Header 1 head1):(Header 2 head2):rest) |
+titleTransform ((Header 1 _ head1):(Header 2 _ head2):rest) |
    not (any (isHeader 1) rest || any (isHeader 2) rest) =  -- both title & subtitle
    (promoteHeaders 2 rest, head1 ++ [Str ":", Space] ++ head2)
-titleTransform ((Header 1 head1):rest) |
+titleTransform ((Header 1 _ head1):rest) |
    not (any (isHeader 1) rest) =  -- title, no subtitle
    (promoteHeaders 1 rest, head1)
 titleTransform blocks = (blocks, [])
diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs
index f2a70612d..3ac7f4efb 100644
--- a/src/Text/Pandoc/Readers/Textile.hs
+++ b/src/Text/Pandoc/Readers/Textile.hs
@@ -171,9 +171,14 @@ header :: Parser [Char] ParserState Block
 header = try $ do
   char 'h'
   level <- digitToInt <$> oneOf "123456"
-  optional attributes >> char '.' >> whitespace
+  attr <- option "" attributes
+  let ident = case attr of
+                   '#':xs -> xs
+                   _      -> ""
+  char '.'
+  whitespace
   name <- normalizeSpaces <$> manyTill inline blockBreak
-  return $ Header level name
+  return $ Header level (ident,[],[]) name
 
 -- | Blockquote of the form "bq. content"
 blockQuote :: Parser [Char] ParserState Block