fix three parser bugs the property tests turned up

fencedCodeBlock had its language test inverted, reporting Nothing for a
fence that names a language and Just "" for one that doesn't.

listBlock's child parser needed a try. optional only recovers from a
failure that consumed nothing, and the child parser eats the next item's
indentation before finding out the item belongs to this list's level
rather than the child's, so any nested list with two or more items killed
the enclosing list and the whole thing came back as a paragraph.

element required a blockEnding, so every block had to be followed by a
blank line or EOF. Paragraphs and headings hid that by swallowing the
following line into their own text; a list has nowhere to put it, and
since listItem already consumed its trailing newline the failure came
with input consumed and escaped document's many, failing the entire
parse. "- a\n:" was a hard error. The ending is optional now and a block
that ends without a blank line is the next block's problem.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Pagwin 2026-09-04 16:39:09 -04:00
parent 628f01217e
commit 96db1f999c
No known key found for this signature in database
GPG key ID: 81137023740CA260

View file

@ -45,7 +45,15 @@ element =
try htmlBlock <?> "HTML Block", try htmlBlock <?> "HTML Block",
paragraphBlock <?> "Paragarph" paragraphBlock <?> "Paragarph"
] ]
<* blockEnding -- a block is normally followed by a blank line or the end of input, but a
-- block that ends without one is the next block's problem rather than a
-- parse error for the whole document. requiring the ending here turned
-- "- a\n:" into a hard failure, because listItem has already eaten the
-- newline that blockEnding wants and the consumed input escapes document's
-- many. the try matters for the same reason optional isn't enough on its
-- own, blockEnding can consume one line ending before finding out there is
-- no second one.
<* optional (try blockEnding)
lineEnding :: (Logger m, Characters s, HasCallStack) => Parser s m () lineEnding :: (Logger m, Characters s, HasCallStack) => Parser s m ()
lineEnding = {-logCallStack *>-} ((try eof) <|> void newline) lineEnding = {-logCallStack *>-} ((try eof) <|> void newline)
@ -137,7 +145,7 @@ fencedCodeBlock = between (string "```") (string "```") $ do
language' <- T.pack <$> (many (notFollowedBy lineEnding *> anySingle)) language' <- T.pack <$> (many (notFollowedBy lineEnding *> anySingle))
lineEnding lineEnding
code <- T.pack <$> (many ((notFollowedBy $ string "```") *> anySingle)) code <- T.pack <$> (many ((notFollowedBy $ string "```") *> anySingle))
let language = if language' == "" then Just language' else Nothing let language = if language' == "" then Nothing else Just language'
pure $ Code (C {language, code}) mempty pure $ Code (C {language, code}) mempty
blockquoteBlock :: (Logger m, Characters s) => Parser s m Element blockquoteBlock :: (Logger m, Characters s) => Parser s m Element
@ -170,7 +178,11 @@ listBlock list_type prefix child_parser_factory nest_level = do
optional ((notFollowedBy blockEnding) *> lineEnding) optional ((notFollowedBy blockEnding) *> lineEnding)
child <- optional $ child_parser_factory $ nest_level + 1 -- the try is load bearing, optional only recovers from a failure that
-- consumed nothing and the child parser eats the next item's indentation
-- before finding out it belongs to this list's level rather than the
-- child's
child <- optional $ try $ child_parser_factory $ nest_level + 1
case child of case child of
Just c -> pure $ LI {content = [Transparent content, List c mempty]} Just c -> pure $ LI {content = [Transparent content, List c mempty]}