Merge pull request #2360 from jg/issue-2354

Org reader: add auto identifiers if not present on headers
This commit is contained in:
John MacFarlane 2015-08-15 09:47:56 -07:00
commit 8c579a5daa
3 changed files with 56 additions and 22 deletions

View file

@ -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,

View file

@ -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

View file

@ -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" =: