Fix function dropping subtrees tagged :noexport:
Continue scanning for comment subtrees beyond only the first block. Note to self: when writing an recursive function, don't forget to, you know, actually recurse. Shout to @mrvdb for noticing this. This fixes #2628.
This commit is contained in:
parent
a5efd2af11
commit
b3b00da43d
2 changed files with 14 additions and 2 deletions
|
@ -87,8 +87,10 @@ parseOrg = do
|
||||||
-- | Drop COMMENT headers and the document tree below those headers.
|
-- | Drop COMMENT headers and the document tree below those headers.
|
||||||
dropCommentTrees :: [Block] -> [Block]
|
dropCommentTrees :: [Block] -> [Block]
|
||||||
dropCommentTrees [] = []
|
dropCommentTrees [] = []
|
||||||
dropCommentTrees blks@(b:bs) =
|
dropCommentTrees (b:bs) =
|
||||||
maybe blks (flip dropUntilHeaderAboveLevel bs) $ commentHeaderLevel b
|
maybe (b:dropCommentTrees bs)
|
||||||
|
(dropCommentTrees . flip dropUntilHeaderAboveLevel bs)
|
||||||
|
(commentHeaderLevel b)
|
||||||
|
|
||||||
-- | Return the level of a header starting a comment or :noexport: tree and
|
-- | Return the level of a header starting a comment or :noexport: tree and
|
||||||
-- Nothing otherwise.
|
-- Nothing otherwise.
|
||||||
|
|
|
@ -569,6 +569,16 @@ tests =
|
||||||
] =?>
|
] =?>
|
||||||
(mempty::Blocks)
|
(mempty::Blocks)
|
||||||
|
|
||||||
|
, "Subtree with :noexport:" =:
|
||||||
|
unlines [ "* Exported"
|
||||||
|
, "** This isn't exported :noexport:"
|
||||||
|
, "*** This neither"
|
||||||
|
, "** But this is"
|
||||||
|
] =?>
|
||||||
|
mconcat [ headerWith ("exported", [], []) 1 "Exported"
|
||||||
|
, headerWith ("but-this-is", [], []) 2 "But this is"
|
||||||
|
]
|
||||||
|
|
||||||
, "Paragraph starting with an asterisk" =:
|
, "Paragraph starting with an asterisk" =:
|
||||||
"*five" =?>
|
"*five" =?>
|
||||||
para "*five"
|
para "*five"
|
||||||
|
|
Loading…
Reference in a new issue