From 05df5885d4cc63c312ded3d7d3854d478e9b2219 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Fri, 5 Jan 2024 11:51:48 +0100 Subject: [PATCH] Parser.takeMultiLine: parse line with actualLine instead of takeLine takeLine accepts empty strings which causes an infinite loop in takeMultiLine when the opening ":{" is not properly closed. --- haddock-library/src/Documentation/Haddock/Parser.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index f42fb4747e..7fa9941acb 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -765,10 +765,15 @@ takeLine = try (takeWhile (/= '\n') <* endOfLine) endOfLine :: Parser () endOfLine = void "\n" <|> Parsec.eof + +actualLine :: Parser Text +actualLine = takeWhile (/= '\n') <* void "\n" + takeMultiLine :: Parser Text takeMultiLine = T.unlines <$> - (try ":{" *> Parsec.manyTill takeLine (try $ skipHorizontalSpace *> ":}\n")) + (try ":{" *> + Parsec.manyTill actualLine (try $ skipHorizontalSpace *> ":}\n")) takeLineOrMultiLine :: Parser Text takeLineOrMultiLine =