aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/test/Documentation/Haddock/ParserSpec.hs
diff options
context:
space:
mode:
authorHécate Moonlight <Kleidukos@users.noreply.github.com>2021-02-07 16:18:10 +0100
committerGitHub <noreply@github.com>2021-02-07 16:18:10 +0100
commita10d042ac76c990764250244ac801db16858b6ee (patch)
tree40f8bc9066d9d96fa00163b10ac85d7645ad01d2 /haddock-library/test/Documentation/Haddock/ParserSpec.hs
parenta2f9f297d17059b3fc68ce4a245702278a5d8340 (diff)
parentc31c156422785751e33c9a7a4f021ac8da77d364 (diff)
Merge pull request #1319 from alexbiehl/alex/compat
Backward compat: Add support for labeled module references
Diffstat (limited to 'haddock-library/test/Documentation/Haddock/ParserSpec.hs')
-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`