GitLab

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

75cadf81

by Ryan Hendrickson at 2025-05-08T06:22:55-04:00

haddock: Preserve indentation in multiline examples

Intended for use with :{ :}, but doesn't look for those characters. Any
consecutive lines with birdtracks will only have initial whitespace
stripped up to the column of the first line.

2 changed files:

utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs

Changes:

utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs

@@ -795,31 +795,33 @@ stripSpace = fromMaybe <*> mapM strip'
  -- | Parses examples. Examples are a paragraph level entity (separated by an empty line).
  -- Consecutive examples are accepted.
  examples :: Parser (DocH mod a)
 -examples = DocExamples <$> (many (try (skipHorizontalSpace *> "\n")) *> go)
 +examples = DocExamples <$> (many (try (skipHorizontalSpace *> "\n")) *> go Nothing)
    where
 -    go :: Parser [Example]
 -    go = do
 +    go :: Maybe Text -> Parser [Example]
 +    go mbInitialIndent = do
        prefix <- takeHorizontalSpace <* ">>>"
 +      initialIndent <- maybe takeHorizontalSpace pure mbInitialIndent
        expr <- takeLine
 -      (rs, es) <- resultAndMoreExamples
 -      return (makeExample prefix expr rs : es)
 +      (rs, es) <- resultAndMoreExamples (Just initialIndent)
 +      return (makeExample prefix initialIndent expr rs : es)
++
 +    resultAndMoreExamples :: Maybe Text -> Parser ([Text], [Example])
 +    resultAndMoreExamples mbInitialIndent = choice' [moreExamples, result, pure ([], [])]
        where
 -        resultAndMoreExamples :: Parser ([Text], [Example])
 -        resultAndMoreExamples = choice' [moreExamples, result, pure ([], [])]
 -          where
 -            moreExamples :: Parser ([Text], [Example])
 -            moreExamples = (,) [] <$> go
 +        moreExamples :: Parser ([Text], [Example])
 +        moreExamples = (,) [] <$> go mbInitialIndent
 -            result :: Parser ([Text], [Example])
 -            result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples
 +        result :: Parser ([Text], [Example])
 +        result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples Nothing
 -    makeExample :: Text -> Text -> [Text] -> Example
 -    makeExample prefix expression res =
 -      Example (T.unpack (T.strip expression)) result
 +    makeExample :: Text -> Text -> Text -> [Text] -> Example
 +    makeExample prefix indent expression res =
 +      Example (T.unpack (tryStripIndent (T.stripEnd expression))) result
        where
          result = map (T.unpack . substituteBlankLine . tryStripPrefix) res
          tryStripPrefix xs = fromMaybe xs (T.stripPrefix prefix xs)
 +        tryStripIndent = liftA2 fromMaybe T.stripStart (T.stripPrefix indent)
          substituteBlankLine "<BLANKLINE>" = ""
          substituteBlankLine xs = xs

utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs

@@ -864,6 +864,29 @@ spec = do
        it "accepts unicode in examples" $ do
          ">>> 灼眼\nシャナ" `shouldParseTo` DocExamples [Example "灼眼" ["シャナ"]]
 +      it "preserves indentation in consecutive example lines" $ do
 +        unlines
 +          [ ">>> line 1"
 +          , ">>>   line 2"
 +          , ">>> line 3"
 +          ]
 +          `shouldParseTo` DocExamples
 +            [ Example "line 1" []
 +            , Example "  line 2" []
 +            , Example "line 3" []
 +            ]
++
 +      it "resets indentation after results" $ do
 +        unlines
 +          [ ">>> line 1"
 +          , "result"
 +          , ">>>   line 2"
 +          ]
 +          `shouldParseTo` DocExamples
 +            [ Example "line 1" ["result"]
 +            , Example "line 2" []
 +            ]
++
        context "when prompt is prefixed by whitespace" $ do
          it "strips the exact same amount of whitespace from result lines" $ do
            unlines