Merge pull request #2360 from jg/issue-2354

Org reader: add auto identifiers if not present on headers

3 files changed, 56 insertions, 22 deletions

diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs
index a0a9de1b2..d7311d978 100644
--- a/src/Text/Pandoc.hs
+++ b/src/Text/Pandoc.hs
@@ -320,7 +320,8 @@ getDefaultExtensions "markdown_mmd" = multimarkdownExtensions
 getDefaultExtensions "markdown_github" = githubMarkdownExtensions
 getDefaultExtensions "markdown"        = pandocExtensions
 getDefaultExtensions "plain"           = plainExtensions
-getDefaultExtensions "org"             = Set.fromList [Ext_citations]
+getDefaultExtensions "org"             = Set.fromList [Ext_citations,
+                                                       Ext_auto_identifiers]
 getDefaultExtensions "textile"         = Set.fromList [Ext_auto_identifiers]
 getDefaultExtensions "html"            = Set.fromList [Ext_auto_identifiers,
                                                        Ext_native_divs,
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 980f63504..55ac92bcb 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -70,6 +70,14 @@ data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext }
 
 type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)
 
+instance HasIdentifierList OrgParserState where
+  extractIdentifierList = orgStateIdentifiers
+  updateIdentifierList f s = s{ orgStateIdentifiers = f (orgStateIdentifiers s) }
+
+instance HasHeaderMap OrgParserState where
+  extractHeaderMap = orgStateHeaderMap
+  updateHeaderMap  f s = s{ orgStateHeaderMap = f (orgStateHeaderMap s) }
+
 parseOrg :: OrgParser Pandoc
 parseOrg = do
   blocks' <- parseBlocks
@@ -135,6 +143,8 @@ data OrgParserState = OrgParserState
                       , orgStateMeta                 :: Meta
                       , orgStateMeta'                :: F Meta
                       , orgStateNotes'               :: OrgNoteTable
+                      , orgStateIdentifiers          :: [String]
+                      , orgStateHeaderMap            :: M.Map Inlines String
                       }
 
 instance Default OrgParserLocal where
@@ -174,6 +184,8 @@ defaultOrgParserState = OrgParserState
                         , orgStateMeta = nullMeta
                         , orgStateMeta' = return nullMeta
                         , orgStateNotes' = []
+                        , orgStateIdentifiers = []
+                        , orgStateHeaderMap = M.empty
                         }
 
 recordAnchorId :: String -> OrgParser ()
@@ -668,7 +680,10 @@ header = try $ do
   title <- manyTill inline (lookAhead headerEnd)
   tags <- headerEnd
   let inlns = trimInlinesF . mconcat $ title <> map tagToInlineF tags
-  return $ B.header level <$> inlns
+  st <- getState
+  let inlines = runF inlns st
+  attr <- registerHeader nullAttr inlines
+  return $ pure (B.headerWith attr level inlines)
  where
    tagToInlineF :: String -> F Inlines
    tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 92e6993df..5eed2c9f4 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -457,21 +457,25 @@ tests =
 
       , "First Level Header" =:
           "* Headline\n" =?>
-          header 1 "Headline"
+          headerWith ("headline", [], []) 1 "Headline"
 
       , "Third Level Header" =:
           "*** Third Level Headline\n" =?>
-          header 3 ("Third" <> space <>
-                    "Level" <> space <>
-                    "Headline")
+          headerWith ("third-level-headline", [], [])
+                     3
+                     ("Third" <> space <> "Level" <> space <> "Headline")
 
       , "Compact Headers with Paragraph" =:
           unlines [ "* First Level"
                   , "** Second Level"
                   , "   Text"
                   ] =?>
-          mconcat [ header 1 ("First" <> space <> "Level")
-                  , header 2 ("Second" <> space <> "Level")
+          mconcat [ headerWith ("first-level", [], [])
+                               1
+                               ("First" <> space <> "Level")
+                  , headerWith ("second-level", [], [])
+                               2
+                               ("Second" <> space <> "Level")
                   , para "Text"
                   ]
 
@@ -482,8 +486,12 @@ tests =
                   , ""
                   , "   Text"
                   ] =?>
-          mconcat [ header 1 ("First" <> space <> "Level")
-                  , header 2 ("Second" <> space <> "Level")
+          mconcat [ headerWith ("first-level", [], [])
+                               1
+                               ("First" <> space <> "Level")
+                  , headerWith ("second-level", [], [])
+                               2
+                               ("Second" <> space <> "Level")
                   , para "Text"
                   ]
 
@@ -492,9 +500,13 @@ tests =
                   , "Spaghetti and meatballs tonight."
                   , "** walk dog"
                   ] =?>
-          mconcat [ header 2 ("eat" <> space <> "dinner")
+          mconcat [ headerWith ("eat-dinner", [], [])
+                               2
+                               ("eat" <> space <> "dinner")
                   , para $ spcSep [ "Spaghetti", "and", "meatballs", "tonight." ]
-                  , header 2 ("walk" <> space <> "dog")
+                  , headerWith ("walk-dog", [], [])
+                               2
+                               ("walk" <> space <> "dog")
                   ]
 
       , "Tagged headers" =:
@@ -503,14 +515,20 @@ tests =
                   , "** Call John     :@PHONE:JOHN: "
                   ] =?>
           let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
-          in mconcat [ header 1 ("Personal" <> tagSpan "PERSONAL")
-                     , header 2 ("Call Mom" <> tagSpan "@PHONE")
-                     , header 2 ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN")
+          in mconcat [ headerWith ("personal", [], [])
+                                  1
+                                  ("Personal" <> tagSpan "PERSONAL")
+                     , headerWith ("call-mom", [], [])
+                                  2
+                                  ("Call Mom" <> tagSpan "@PHONE")
+                     , headerWith ("call-john", [], [])
+                                  2
+                                  ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN")
                      ]
 
       , "Untagged header containing colons" =:
           "* This: is not: tagged" =?>
-          header 1 "This: is not: tagged"
+          headerWith ("this-is-not-tagged", [], []) 1 "This: is not: tagged"
 
       , "Comment Trees" =:
           unlines [ "* COMMENT A comment tree"
@@ -518,7 +536,7 @@ tests =
                   , "** This will be dropped"
                   , "* Comment tree above"
                   ] =?>
-          header 1 "Comment tree above"
+          headerWith ("comment-tree-above", [], []) 1 "Comment tree above"
 
       , "Nothing but a COMMENT header" =:
           "* COMMENT Test" =?>
@@ -640,7 +658,7 @@ tests =
                   [ "Another", space, "note"
                   , note $ para ("This" <> space <> "is" <> space <> "great!")
                   ])
-          , header 2 "Headline"
+          , headerWith ("headline", [], []) 2 "Headline"
           ]
       ]
 
@@ -664,7 +682,7 @@ tests =
            "* Item2\n") =?>
           bulletList [ plain "Item1"
                      ] <>
-          header 1 "Item2"
+          headerWith ("item2", [], []) 1 "Item2"
 
       , "Multi-line Bullet Lists" =:
           ("- *Fat\n" ++
@@ -724,7 +742,7 @@ tests =
           mconcat [ bulletList [ plain "Discovery"
                                , plain ("Human" <> space <> "After" <> space <> "All")
                                ]
-                  , header 1 "Homework"
+                  , headerWith ("homework", [], []) 1 "Homework"
                   ]
 
       , "Bullet List Unindented with trailing Header" =:
@@ -734,7 +752,7 @@ tests =
           mconcat [ bulletList [ plain "Discovery"
                                , plain "Homework"
                                ]
-                  , header 1 "NotValidListItem"
+                  , headerWith ("notvalidlistitem", [], []) 1 "NotValidListItem"
                   ]
 
       , "Simple Ordered List" =:
@@ -839,7 +857,7 @@ tests =
           mconcat [ definitionList [ ("definition", [plain "list"])
                                    , ("cool", [plain "defs"])
                                    ]
-                  , header 1 "header"
+                  , headerWith ("header", [], []) 1 "header"
                   ]
 
       , "Loose bullet list" =: