git.iko.soy/typeable/pandoc
on master help sign in
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

commitf1c87ed16452c96426864a83beb036a4d09d1988 authorJuliusz Gonera <juliusz.gonera@gmail.com> dateSat 15 Aug 2015, 07:54 (11 years ago) parentaa08b4c
3 files changed+56−22
src/Text/Pandoc.hs+2−1 src/Text/Pandoc/Readers/Org.hs+16−1 tests/Tests/Readers/Org.hs+38−20
src/Text/Pandoc.hs+2−1
@@ -320,7 +320,8 @@ getDefaultExtensions "markdown_mmd" = multimarkdownExtensions
320320getDefaultExtensions "markdown_github" = githubMarkdownExtensions
321321getDefaultExtensions "markdown" = pandocExtensions
322322getDefaultExtensions "plain" = plainExtensions
323−getDefaultExtensions "org" = Set.fromList [Ext_citations]
323+getDefaultExtensions "org" = Set.fromList [Ext_citations,
324+ Ext_auto_identifiers]
324325getDefaultExtensions "textile" = Set.fromList [Ext_auto_identifiers]
325326getDefaultExtensions "html" = Set.fromList [Ext_auto_identifiers,
326327 Ext_native_divs,
src/Text/Pandoc/Readers/Org.hs+16−1
@@ -70,6 +70,14 @@ data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext }
7070
7171type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)
7272
73+instance HasIdentifierList OrgParserState where
74+ extractIdentifierList = orgStateIdentifiers
75+ updateIdentifierList f s = s{ orgStateIdentifiers = f (orgStateIdentifiers s) }
76+
77+instance HasHeaderMap OrgParserState where
78+ extractHeaderMap = orgStateHeaderMap
79+ updateHeaderMap f s = s{ orgStateHeaderMap = f (orgStateHeaderMap s) }
80+
7381parseOrg :: OrgParser Pandoc
7482parseOrg = do
7583 blocks' <- parseBlocks
@@ -135,6 +143,8 @@ data OrgParserState = OrgParserState
135143 , orgStateMeta :: Meta
136144 , orgStateMeta' :: F Meta
137145 , orgStateNotes' :: OrgNoteTable
146+ , orgStateIdentifiers :: [String]
147+ , orgStateHeaderMap :: M.Map Inlines String
138148 }
139149
140150instance Default OrgParserLocal where
@@ -174,6 +184,8 @@ defaultOrgParserState = OrgParserState
174184 , orgStateMeta = nullMeta
175185 , orgStateMeta' = return nullMeta
176186 , orgStateNotes' = []
187+ , orgStateIdentifiers = []
188+ , orgStateHeaderMap = M.empty
177189 }
178190
179191recordAnchorId :: String -> OrgParser ()
@@ -668,7 +680,10 @@ header = try $ do
668680 title <- manyTill inline (lookAhead headerEnd)
669681 tags <- headerEnd
670682 let inlns = trimInlinesF . mconcat $ title <> map tagToInlineF tags
671− return $ B.header level <$> inlns
683+ st <- getState
684+ let inlines = runF inlns st
685+ attr <- registerHeader nullAttr inlines
686+ return $ pure (B.headerWith attr level inlines)
672687 where
673688 tagToInlineF :: String -> F Inlines
674689 tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
tests/Tests/Readers/Org.hs+38−20
@@ -457,21 +457,25 @@ tests =
457457
458458 , "First Level Header" =:
459459 "* Headline\n" =?>
460− header 1 "Headline"
460+ headerWith ("headline", [], []) 1 "Headline"
461461
462462 , "Third Level Header" =:
463463 "*** Third Level Headline\n" =?>
464− header 3 ("Third" <> space <>
465− "Level" <> space <>
466− "Headline")
464+ headerWith ("third-level-headline", [], [])
465+ 3
466+ ("Third" <> space <> "Level" <> space <> "Headline")
467467
468468 , "Compact Headers with Paragraph" =:
469469 unlines [ "* First Level"
470470 , "** Second Level"
471471 , " Text"
472472 ] =?>
473− mconcat [ header 1 ("First" <> space <> "Level")
474− , header 2 ("Second" <> space <> "Level")
473+ mconcat [ headerWith ("first-level", [], [])
474+ 1
475+ ("First" <> space <> "Level")
476+ , headerWith ("second-level", [], [])
477+ 2
478+ ("Second" <> space <> "Level")
475479 , para "Text"
476480 ]
477481
@@ -482,8 +486,12 @@ tests =
482486 , ""
483487 , " Text"
484488 ] =?>
485− mconcat [ header 1 ("First" <> space <> "Level")
486− , header 2 ("Second" <> space <> "Level")
489+ mconcat [ headerWith ("first-level", [], [])
490+ 1
491+ ("First" <> space <> "Level")
492+ , headerWith ("second-level", [], [])
493+ 2
494+ ("Second" <> space <> "Level")
487495 , para "Text"
488496 ]
489497
@@ -492,9 +500,13 @@ tests =
492500 , "Spaghetti and meatballs tonight."
493501 , "** walk dog"
494502 ] =?>
495− mconcat [ header 2 ("eat" <> space <> "dinner")
503+ mconcat [ headerWith ("eat-dinner", [], [])
504+ 2
505+ ("eat" <> space <> "dinner")
496506 , para $ spcSep [ "Spaghetti", "and", "meatballs", "tonight." ]
497− , header 2 ("walk" <> space <> "dog")
507+ , headerWith ("walk-dog", [], [])
508+ 2
509+ ("walk" <> space <> "dog")
498510 ]
499511
500512 , "Tagged headers" =:
@@ -503,14 +515,20 @@ tests =
503515 , "** Call John :@PHONE:JOHN: "
504516 ] =?>
505517 let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
506− in mconcat [ header 1 ("Personal" <> tagSpan "PERSONAL")
507− , header 2 ("Call Mom" <> tagSpan "@PHONE")
508− , header 2 ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN")
518+ in mconcat [ headerWith ("personal", [], [])
519+ 1
520+ ("Personal" <> tagSpan "PERSONAL")
521+ , headerWith ("call-mom", [], [])
522+ 2
523+ ("Call Mom" <> tagSpan "@PHONE")
524+ , headerWith ("call-john", [], [])
525+ 2
526+ ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN")
509527 ]
510528
511529 , "Untagged header containing colons" =:
512530 "* This: is not: tagged" =?>
513− header 1 "This: is not: tagged"
531+ headerWith ("this-is-not-tagged", [], []) 1 "This: is not: tagged"
514532
515533 , "Comment Trees" =:
516534 unlines [ "* COMMENT A comment tree"
@@ -518,7 +536,7 @@ tests =
518536 , "** This will be dropped"
519537 , "* Comment tree above"
520538 ] =?>
521− header 1 "Comment tree above"
539+ headerWith ("comment-tree-above", [], []) 1 "Comment tree above"
522540
523541 , "Nothing but a COMMENT header" =:
524542 "* COMMENT Test" =?>
@@ -640,7 +658,7 @@ tests =
640658 [ "Another", space, "note"
641659 , note $ para ("This" <> space <> "is" <> space <> "great!")
642660 ])
643− , header 2 "Headline"
661+ , headerWith ("headline", [], []) 2 "Headline"
644662 ]
645663 ]
646664
@@ -664,7 +682,7 @@ tests =
664682 "* Item2\n") =?>
665683 bulletList [ plain "Item1"
666684 ] <>
667− header 1 "Item2"
685+ headerWith ("item2", [], []) 1 "Item2"
668686
669687 , "Multi-line Bullet Lists" =:
670688 ("- *Fat\n" ++
@@ -724,7 +742,7 @@ tests =
724742 mconcat [ bulletList [ plain "Discovery"
725743 , plain ("Human" <> space <> "After" <> space <> "All")
726744 ]
727− , header 1 "Homework"
745+ , headerWith ("homework", [], []) 1 "Homework"
728746 ]
729747
730748 , "Bullet List Unindented with trailing Header" =:
@@ -734,7 +752,7 @@ tests =
734752 mconcat [ bulletList [ plain "Discovery"
735753 , plain "Homework"
736754 ]
737− , header 1 "NotValidListItem"
755+ , headerWith ("notvalidlistitem", [], []) 1 "NotValidListItem"
738756 ]
739757
740758 , "Simple Ordered List" =:
@@ -839,7 +857,7 @@ tests =
839857 mconcat [ definitionList [ ("definition", [plain "list"])
840858 , ("cool", [plain "defs"])
841859 ]
842− , header 1 "header"
860+ , headerWith ("header", [], []) 1 "header"
843861 ]
844862
845863 , "Loose bullet list" =: