aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/test
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2021-02-08 12:54:33 -0500
committerBen Gamari <ben@smart-cactus.org>2021-02-08 12:54:33 -0500
commite57d82dde105ffbfcb27ab261041c97b4dd0150a (patch)
treee4716c076ef5f05d63235bbf475f939fa1ed402f /haddock-library/test
parentb995bfe84f9766e23ff78d7ccd520ec7d8cdbebc (diff)
parent4f1a309700106b62831309931e449a603093f521 (diff)
Merge remote-tracking branch 'upstream/ghc-head' into ghc-head
Diffstat (limited to 'haddock-library/test')
-rw-r--r--haddock-library/test/Documentation/Haddock/ParserSpec.hs84
1 files changed, 75 insertions, 9 deletions
diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
index 1724c664..5fa73ecd 100644
--- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs
+++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
@@ -403,20 +403,20 @@ spec = do
context "when parsing module strings" $ do
it "should parse a module on its own" $ do
"\"Module\"" `shouldParseTo`
- DocModule "Module"
+ DocModule (ModLink "Module" Nothing)
it "should parse a module inline" $ do
"This is a \"Module\"." `shouldParseTo`
- "This is a " <> DocModule "Module" <> "."
+ "This is a " <> DocModule (ModLink "Module" Nothing) <> "."
it "can accept a simple module name" $ do
- "\"Hello\"" `shouldParseTo` DocModule "Hello"
+ "\"Hello\"" `shouldParseTo` DocModule (ModLink "Hello" Nothing)
it "can accept a module name with dots" $ do
- "\"Hello.World\"" `shouldParseTo` DocModule "Hello.World"
+ "\"Hello.World\"" `shouldParseTo` DocModule (ModLink "Hello.World" Nothing)
it "can accept a module name with unicode" $ do
- "\"Hello.Worldλ\"" `shouldParseTo` DocModule "Hello.Worldλ"
+ "\"Hello.Worldλ\"" `shouldParseTo` DocModule (ModLink "Hello.Worldλ" Nothing)
it "parses a module name with a trailing dot as regular quoted string" $ do
"\"Hello.\"" `shouldParseTo` "\"Hello.\""
@@ -428,19 +428,85 @@ spec = do
"\"Hello&[{}(=*)+]!\"" `shouldParseTo` "\"Hello&[{}(=*)+]!\""
it "accepts a module name with unicode" $ do
- "\"Foo.Barλ\"" `shouldParseTo` DocModule "Foo.Barλ"
+ "\"Foo.Barλ\"" `shouldParseTo` DocModule (ModLink "Foo.Barλ" Nothing)
it "treats empty module name as regular double quotes" $ do
"\"\"" `shouldParseTo` "\"\""
it "accepts anchor reference syntax as DocModule" $ do
- "\"Foo#bar\"" `shouldParseTo` DocModule "Foo#bar"
+ "\"Foo#bar\"" `shouldParseTo` DocModule (ModLink "Foo#bar" Nothing)
it "accepts anchor with hyphen as DocModule" $ do
- "\"Foo#bar-baz\"" `shouldParseTo` DocModule "Foo#bar-baz"
+ "\"Foo#bar-baz\"" `shouldParseTo` DocModule (ModLink "Foo#bar-baz" Nothing)
it "accepts old anchor reference syntax as DocModule" $ do
- "\"Foo\\#bar\"" `shouldParseTo` DocModule "Foo\\#bar"
+ "\"Foo\\#bar\"" `shouldParseTo` DocModule (ModLink "Foo\\#bar" Nothing)
+
+ context "when parsing labeled module links" $ do
+ it "parses a simple labeled module link" $ do
+ "[some label](\"Some.Module\")" `shouldParseTo`
+ DocModule (ModLink "Some.Module" (Just "some label"))
+
+ it "allows escaping in label" $ do
+ "[some\\] label](\"Some.Module\")" `shouldParseTo`
+ DocModule (ModLink "Some.Module" (Just "some] label"))
+
+ it "strips leading and trailing whitespace from label" $ do
+ "[ some label ](\"Some.Module\")" `shouldParseTo`
+ DocModule (ModLink "Some.Module" (Just "some label"))
+
+ it "allows whitespace in module name link" $ do
+ "[some label]( \"Some.Module\"\t )" `shouldParseTo`
+ DocModule (ModLink "Some.Module" (Just "some label"))
+
+ it "allows inline markup in the label" $ do
+ "[something /emphasized/](\"Some.Module\")" `shouldParseTo`
+ DocModule (ModLink "Some.Module" (Just ("something " <> DocEmphasis "emphasized")))
+
+ it "should parse a labeled module on its own" $ do
+ "[label](\"Module\")" `shouldParseTo`
+ DocModule (ModLink "Module" (Just "label"))
+
+ it "should parse a labeled module inline" $ do
+ "This is a [label](\"Module\")." `shouldParseTo`
+ "This is a " <> DocModule (ModLink "Module" (Just "label")) <> "."
+
+ it "can accept a labeled module name with dots" $ do
+ "[label](\"Hello.World\")" `shouldParseTo` DocModule (ModLink "Hello.World" (Just "label"))
+
+ it "can accept a labeled module name with unicode" $ do
+ "[label](\"Hello.Worldλ\")" `shouldParseTo` DocModule (ModLink "Hello.Worldλ" (Just "label"))
+
+ it "parses a labeled module name with a trailing dot as a hyperlink" $ do
+ "[label](\"Hello.\")" `shouldParseTo`
+ hyperlink "\"Hello.\"" (Just "label")
+
+ it "parses a labeled module name with a space as a regular string" $ do
+ "[label](\"Hello World\")" `shouldParseTo` "[label](\"Hello World\")"
+
+ it "parses a module name with invalid characters as a hyperlink" $ do
+ "[label](\"Hello&[{}(=*+]!\")" `shouldParseTo`
+ hyperlink "\"Hello&[{}(=*+]!\"" (Just "label")
+
+ it "accepts a labeled module name with unicode" $ do
+ "[label](\"Foo.Barλ\")" `shouldParseTo`
+ DocModule (ModLink "Foo.Barλ" (Just "label"))
+
+ it "treats empty labeled module name as empty hyperlink" $ do
+ "[label](\"\")" `shouldParseTo`
+ hyperlink "\"\"" (Just "label")
+
+ it "accepts anchor reference syntax for labeled module name" $ do
+ "[label](\"Foo#bar\")" `shouldParseTo`
+ DocModule (ModLink "Foo#bar" (Just "label"))
+
+ it "accepts old anchor reference syntax for labeled module name" $ do
+ "[label](\"Foo\\#bar\")" `shouldParseTo`
+ DocModule (ModLink "Foo\\#bar" (Just "label"))
+
+ it "interprets empty label as a unlabeled module name" $ do
+ "[](\"Module.Name\")" `shouldParseTo`
+ "[](" <> DocModule (ModLink "Module.Name" Nothing) <> ")"
describe "parseParas" $ do
let infix 1 `shouldParseTo`