From f1c87ed16452c96426864a83beb036a4d09d1988 Mon Sep 17 00:00:00 2001 From: Juliusz Gonera Date: Sat, 15 Aug 2015 07:54:38 +0200 Subject: Org reader: add auto identifiers if not present on headers Refs #2354 This should also fix the table of contents (--toc) when generating a html file from org input --- src/Text/Pandoc.hs | 3 ++- src/Text/Pandoc/Readers/Org.hs | 17 ++++++++++++- tests/Tests/Readers/Org.hs | 58 +++++++++++++++++++++++++++--------------- 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" =: -- cgit v1.2.3