Skip to content
This repository was archived by the owner on Aug 3, 2024. It is now read-only.

Commit d604edd

Browse files
committed
Forbid spaces in anchors (#1148)
1 parent f493817 commit d604edd

File tree

3 files changed

+7
-4
lines changed

3 files changed

+7
-4
lines changed

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -227,7 +227,7 @@ takeWhile1_ = mfilter (not . T.null) . takeWhile_
227227
-- DocAName "Hello world"
228228
anchor :: Parser (DocH mod a)
229229
anchor = DocAName . T.unpack <$>
230-
disallowNewline ("#" *> takeWhile1_ (/= '#') <* "#")
230+
("#" *> takeWhile1_ (\x -> x /= '#' && not (isSpace x)) <* "#")
231231

232232
-- | Monospaced strings.
233233
--

haddock-library/src/Documentation/Haddock/Types.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -126,7 +126,7 @@ data DocH mod id
126126
| DocMathInline String
127127
| DocMathDisplay String
128128
| DocAName String
129-
-- ^ A (HTML) anchor.
129+
-- ^ A (HTML) anchor. It must not contain any spaces.
130130
| DocProperty String
131131
| DocExamples [Example]
132132
| DocHeader (Header (DocH mod id))

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

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -288,8 +288,8 @@ spec = do
288288
it "parses a single word anchor" $ do
289289
"#foo#" `shouldParseTo` DocAName "foo"
290290

291-
it "parses a multi word anchor" $ do
292-
"#foo bar#" `shouldParseTo` DocAName "foo bar"
291+
it "doesn't parse a multi word anchor" $ do
292+
"#foo bar#" `shouldParseTo` "#foo bar#"
293293

294294
it "parses a unicode anchor" $ do
295295
"#灼眼のシャナ#" `shouldParseTo` DocAName "灼眼のシャナ"
@@ -304,6 +304,9 @@ spec = do
304304
it "does not accept empty anchors" $ do
305305
"##" `shouldParseTo` "##"
306306

307+
it "does not accept anchors containing spaces" $ do
308+
"{-# LANGUAGE GADTs #-}" `shouldParseTo` "{-# LANGUAGE GADTs #-}"
309+
307310
context "when parsing emphasised text" $ do
308311
it "emphasises a word on its own" $ do
309312
"/foo/" `shouldParseTo` DocEmphasis "foo"

0 commit comments

Comments
 (0)