Merge pull request #2360 from jg/issue-2354
Org reader: add auto identifiers if not present on headers
This commit is contained in:
commit
8c579a5daa
3 changed files with 56 additions and 22 deletions
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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" =:
|
||||
|
|
Loading…
Add table
Reference in a new issue