diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/Haddock/ParseSpec.hs | 432 | ||||
| -rw-r--r-- | test/Haddock/Utf8Spec.hs | 15 |
2 files changed, 336 insertions, 111 deletions
diff --git a/test/Haddock/ParseSpec.hs b/test/Haddock/ParseSpec.hs index 799330c2..b649d901 100644 --- a/test/Haddock/ParseSpec.hs +++ b/test/Haddock/ParseSpec.hs @@ -6,15 +6,16 @@ module Haddock.ParseSpec (main, spec) where import Control.Applicative +import Data.Maybe (isJust) import Data.Monoid import Data.String import Haddock.Doc (combineStringNodes) -import Haddock.Lex (tokenise) -import qualified Haddock.Parse as Parse +import qualified Haddock.Parser as Parse import Haddock.Types import Outputable (Outputable, showSDoc, ppr) import RdrName (RdrName) import Test.Hspec +import Test.QuickCheck (property) import Helper @@ -32,25 +33,111 @@ instance IsString a => IsString (Maybe a) where fromString = Just . fromString parseParas :: String -> Maybe (Doc RdrName) -parseParas s = Parse.parseParas $ tokenise dynFlags s (0,0) +parseParas = Parse.parseParas dynFlags parseString :: String -> Maybe (Doc RdrName) -parseString s = Parse.parseString $ tokenise dynFlags s (0,0) +parseString = Parse.parseString dynFlags main :: IO () main = hspec spec -infix 1 `shouldParseTo` -shouldParseTo :: String -> Doc RdrName -> Expectation -shouldParseTo input ast = (combineStringNodes <$> parseParas input) - `shouldBe` Just ast - spec :: Spec spec = do + + let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String)) + + describe "parseString" $ do + let infix 1 `shouldParseTo` + shouldParseTo :: String -> Doc RdrName -> Expectation + shouldParseTo input ast = parseString input `shouldBe` Just ast + + it "is total" $ do + property $ \xs -> + -- filter out primes as we might end up with an identifier + -- which will fail due to undefined DynFlags + parseString (filter (/= '\'') xs) `shouldSatisfy` isJust + + context "when parsing URLs" $ do + it "parses a URL" $ do + "<http://example.com/>" `shouldParseTo` + hyperlink "http://example.com/" Nothing <> "\n" + + it "accepts an optional label" $ do + "<http://example.com/ some link>" `shouldParseTo` + hyperlink "http://example.com/" "some link" <> "\n" + + it "finishes URL parsing as soon as it sees >, even if it's escaped" $ do + "<http://examp\\>le.com" `shouldParseTo` + hyperlink "http://examp\\" Nothing <> "le.com\n" + + "<http://exa\\>mp\\>le.com>" `shouldParseTo` + hyperlink "http://exa\\" Nothing <> "mp>le.com>\n" + + -- Likewise in label + "<http://example.com f\\>oo>" `shouldParseTo` + hyperlink "http://example.com" "f\\" <> "oo>\n" + + it "parses inline URLs" $ do + "Not yet working, see <http://trac.haskell.org/haddock/ticket/223>\n , isEmptyChan" `shouldParseTo` + "Not yet working, see " + <> hyperlink "http://trac.haskell.org/haddock/ticket/223" Nothing + <> "\n , isEmptyChan\n" + + context "when autolinking URLs" $ do + it "autolinks HTTP URLs" $ do + "http://example.com/" `shouldParseTo` + hyperlink "http://example.com/" Nothing <> "\n" + + it "autolinks HTTPS URLs" $ do + "https://www.example.com/" `shouldParseTo` + hyperlink "https://www.example.com/" Nothing <> "\n" + + it "autolinks FTP URLs" $ do + "ftp://example.com/" `shouldParseTo` + hyperlink "ftp://example.com/" Nothing <> "\n" + + it "does not include a trailing exclamation mark" $ do + "http://example.com/! Some other sentence." `shouldParseTo` + hyperlink "http://example.com/" Nothing <> "! Some other sentence.\n" + + it "does not include a trailing comma" $ do + "http://example.com/, Some other sentence." `shouldParseTo` + hyperlink "http://example.com/" Nothing <> ", Some other sentence.\n" + + it "does not include a trailing dot" $ do + "http://example.com/. Some other sentence." `shouldParseTo` + hyperlink "http://example.com/" Nothing <> ". Some other sentence.\n" + + it "does not include a trailing question mark" $ do + "http://example.com/? Some other sentence." `shouldParseTo` + hyperlink "http://example.com/" Nothing <> "? Some other sentence.\n" + + describe "parseParas" $ do + let infix 1 `shouldParseTo` + shouldParseTo :: String -> Doc RdrName -> Expectation + shouldParseTo input ast = (combineStringNodes <$> parseParas input) + `shouldBe` Just ast + + it "is total" $ do + property $ \xs -> + -- filter out primes as we might end up with an identifier + -- which will fail due to undefined DynFlags + parseParas (filter (/= '\'') xs) `shouldSatisfy` isJust + it "parses a paragraph" $ do "foobar" `shouldParseTo` DocParagraph "foobar\n" + it "empty input produces DocEmpty" $ do + "" `shouldParseTo` DocEmpty + + it "should preserve all regular characters" $ do + property $ \xs -> + let input = filterSpecial xs + in case input of + [] -> input `shouldParseTo` DocEmpty + _ -> input `shouldParseTo` DocParagraph (DocString $ input ++ "\n") + context "when parsing a simple string" $ do it "] should be made into a DocString" $ do "hell]o" `shouldParseTo` DocParagraph "hell]o\n" @@ -65,7 +152,7 @@ spec = do it "should parse a module inline" $ do "This is a \"Module\"." `shouldParseTo` - DocParagraph ("This is a " <> ((DocModule "Module") <> ".\n")) + DocParagraph ("This is a " <> (DocModule "Module" <> ".\n")) context "when parsing emphasised strings" $ do it "emphasises a word on its own" $ do @@ -80,7 +167,7 @@ spec = do "/灼眼のシャナ/" `shouldParseTo` (DocParagraph $ DocEmphasis "灼眼のシャナ" <> "\n") - it "does /multi-line\\n codeblocks/" $ do + it "does not do /multi-line\\n emphasis/" $ do " /multi-line\n emphasis/" `shouldParseTo` DocParagraph "/multi-line\n emphasis/\n" @@ -99,7 +186,7 @@ spec = do it "accepts other elements in a codeblock" $ do "@/emphasis/ \"Module\" <<picture>>@" `shouldParseTo` (DocCodeBlock $ DocEmphasis "emphasis" <> " " - <> DocModule "Module" <> " " <> DocPic "picture") + <> DocModule "Module" <> " " <> pic "picture" Nothing) context "when parsing monospaced strings" $ do it "monospaces inline strings" $ do @@ -107,6 +194,10 @@ spec = do (DocParagraph $ "This comment applies to the " <> DocMonospaced "following" <> " declaration\n") + it "should allow us to escape the @" $ do + "foo @hey \\@ world@ bar" `shouldParseTo` + DocParagraph ("foo " <> DocMonospaced "hey @ world" <> " bar\n") + it "monospaces inline unicode" $ do "hello @灼眼のシャナ@ unicode" `shouldParseTo` (DocParagraph $ "hello " @@ -115,17 +206,43 @@ spec = do it "accepts other elements in a monospaced section" $ do "hey @/emphasis/ \"Module\" <<picture>>@ world" `shouldParseTo` (DocParagraph $ - "hey " - <> DocMonospaced (DocEmphasis "emphasis" <> " " - <> DocModule "Module" <> " " <> DocPic "picture") - <> " world\n") + "hey " + <> DocMonospaced (DocEmphasis "emphasis" <> " " + <> DocModule "Module" <> " " <> pic "picture" Nothing) + <> " world\n") context "when parsing unordered lists" $ do it "parses a simple unordered list" $ do "* point one\n\n* point two" `shouldParseTo` DocUnorderedList [ DocParagraph " point one\n" - , DocParagraph " point two\n"] + , DocParagraph " point two\n"] + + "* 1.parameter re : the derived regular expression" + ++ "\n\n- returns : empty String" `shouldParseTo` + (DocUnorderedList + [DocParagraph " 1.parameter re : the derived regular expression\n", + DocParagraph " returns : empty String\n"]) + + it "doesn't accept a list where unexpected" $ do + " expression?\n -> matches\n\n * 1.parameter \n\n" + `shouldParseTo` + DocParagraph "expression?\n -> matches\n" <> DocUnorderedList [DocParagraph " 1.parameter \n"] + + + it "parses a simple unordered list without the empty line separator" $ do + "* point one\n* point two" `shouldParseTo` + DocUnorderedList [ DocParagraph " point one\n" + , DocParagraph " point two\n"] + + "* point one\nmore one\n* point two\nmore two" `shouldParseTo` + DocUnorderedList [ DocParagraph " point one\nmore one\n" + , DocParagraph " point two\nmore two\n"] + + " * point one\nmore one\n * point two\nmore two" `shouldParseTo` + DocUnorderedList [ DocParagraph " point one\nmore one\n" + , DocParagraph " point two\nmore two\n" + ] it "parses an empty unordered list" $ do "*" `shouldParseTo` DocUnorderedList [DocParagraph "\n"] @@ -134,6 +251,9 @@ spec = do "* 灼眼のシャナ" `shouldParseTo` DocUnorderedList [DocParagraph " 灼眼のシャナ\n"] + it "preserves whitespace on the front of additional lines" $ do + "* foo\n bar" `shouldParseTo` DocUnorderedList [DocParagraph " foo\n bar\n"] + it "accepts other elements in an unordered list" $ do ("* \"Module\"\n\n* /emphasis/" ++ "\n\n* @code@\n\n* a@mono@b \n\n*") `shouldParseTo` @@ -141,17 +261,43 @@ spec = do DocParagraph (" " <> DocModule "Module" <> "\n") , DocParagraph (" " <> DocEmphasis "emphasis" <> "\n") , DocCodeBlock "code" - , DocParagraph (" a" <> (DocMonospaced "mono") <> "b \n") + , DocParagraph (" a" <> DocMonospaced "mono" <> "b \n") + , DocParagraph "\n" + ] + + ("* \"Module\"\n* /emphasis/" + ++ "\n* @code@\n* a@mono@b \n*") `shouldParseTo` + DocUnorderedList [ + DocParagraph (" " <> DocModule "Module" <> "\n") + , DocParagraph (" " <> DocEmphasis "emphasis" <> "\n") + , DocCodeBlock "code" + , DocParagraph (" a" <> DocMonospaced "mono" <> "b \n") , DocParagraph "\n" ] context "when parsing ordered lists" $ do it "parses a simple ordered list" $ do "1. point one\n\n2. point two" `shouldParseTo` - DocOrderedList [ - DocParagraph " point one\n" - , DocParagraph " point two\n" - ] + DocOrderedList [ DocParagraph " point one\n" + , DocParagraph " point two\n" + ] + + it "parses a simple ordered list without the newline separator" $ do + "1. point one\n2. point two" `shouldParseTo` + DocOrderedList [ DocParagraph " point one\n" + , DocParagraph " point two\n" + ] + + "1. point one\nmore\n2. point two\nmore" `shouldParseTo` + DocOrderedList [ DocParagraph " point one\nmore\n" + , DocParagraph " point two\nmore\n" + ] + + -- space before list + " 1. point one\nmore\n 2. point two\nmore" `shouldParseTo` + DocOrderedList [ DocParagraph " point one\nmore\n" + , DocParagraph " point two\nmore\n" + ] it "parses an empty list" $ do "1." `shouldParseTo` DocOrderedList [DocParagraph "\n"] @@ -165,6 +311,9 @@ spec = do "(1) 灼眼のシャナ" `shouldParseTo` DocOrderedList [DocParagraph " 灼眼のシャナ\n"] + it "preserves whitespace on the front of additional lines" $ do + "1. foo\n bar" `shouldParseTo` DocOrderedList [DocParagraph " foo\n bar\n"] + it "accepts other elements" $ do ("1. \"Module\"\n\n2. /emphasis/" ++ "\n\n3. @code@\n\n4. a@mono@b \n\n5.") `shouldParseTo` @@ -181,6 +330,16 @@ spec = do "[foo] bar\n\n[baz] quux" `shouldParseTo` DocDefList [("foo", " bar\n"), ("baz", " quux\n")] + it "parses a simple list without the newline separator" $ do + "[foo] bar\n[baz] quux" `shouldParseTo` + DocDefList [("foo", " bar\n"), ("baz", " quux\n")] + + "[foo] bar\nmore\n[baz] quux\nmore" `shouldParseTo` + DocDefList [("foo", " bar\nmore\n"), ("baz", " quux\nmore\n")] + + " [foo] bar\nmore\n [baz] quux\nmore" `shouldParseTo` + DocDefList [("foo", " bar\nmore\n"), ("baz", " quux\nmore\n")] + it "parses a list with unicode in it" $ do "[灼眼] シャナ" `shouldParseTo` DocDefList [("灼眼", " シャナ\n")] @@ -197,6 +356,26 @@ spec = do "[[world]] bar" `shouldParseTo` DocDefList [("[world", "] bar\n")] + it "treats broken up definition list as regular string" $ do + "[qu\nx] hey" `shouldParseTo` DocParagraph "[qu\nx] hey\n" + + it "preserves whitespace on the front of additional lines" $ do + "[foo] bar\n baz" `shouldParseTo` DocDefList [("foo", " bar\n baz\n")] + + context "when parsing consecutive paragraphs" $ do + it "will not capture irrelevant consecutive lists" $ do + " * bullet\n\n - different bullet\n\n (1) ordered\n \n " + ++ "2. different bullet\n \n [cat] kitten\n \n [pineapple] fruit" + `shouldParseTo` + DocUnorderedList [ DocParagraph " bullet\n" + , DocParagraph " different bullet\n"] + <> DocOrderedList [ DocParagraph " ordered\n" + , DocParagraph " different bullet\n" + ] + <> DocDefList [ ("cat", " kitten\n") + , ("pineapple", " fruit\n") + ] + context "when parsing an example" $ do it ("requires an example to be separated" ++ " from a previous paragraph by an empty line") $ do @@ -205,27 +384,50 @@ spec = do <> DocExamples [Example "fib 10" ["55"]] -- parse error - parseParas "foobar\n>>> fib 10\n55" `shouldBe` Nothing + it "parses bird-tracks inside of paragraphs as plain strings" $ do + "foobar\n>>> fib 10\n55" `shouldParseTo` DocParagraph "foobar\n>>> fib 10\n55\n" it "parses a prompt with no example results" $ do " >>> import Data.Char\n " `shouldParseTo` DocExamples [ Example { exampleExpression = "import Data.Char" - , exampleResult = [] - } - ] + , exampleResult = [] + } + ] it "is able to parse example sections with unicode" $ do " >>> 灼眼\n の\n >>> シャナ\n 封絶" `shouldParseTo` DocExamples [ Example { exampleExpression = "灼眼" - , exampleResult = ["の"] - } - , Example { exampleExpression = "シャナ" - , exampleResult = ["封絶"] - } - ] + , exampleResult = ["の"] + } + , Example { exampleExpression = "シャナ" + , exampleResult = ["封絶"] + } + ] + it "preserves whitespace before the prompt with consecutive paragraphs" $ do + " Examples:\n\n >>> fib 5\n 5\n >>> fib 10\n 55\n\n >>> fib 10\n 55" + `shouldParseTo` + DocParagraph "Examples:\n" + <> DocExamples [ Example { exampleExpression = "fib 5" + , exampleResult = ["5"]} + , Example {exampleExpression = "fib 10" + , exampleResult = ["55"]}] + <> DocExamples [ Example { exampleExpression = "fib 10" + , exampleResult = ["55"]}] + + it "can parse consecutive prompts with results" $ do + " >>> fib 5\n 5\n >>> fib 10\n 55" `shouldParseTo` + DocExamples [ Example { exampleExpression = "fib 5" + , exampleResult = ["5"] } + , Example { exampleExpression = "fib 10" + , exampleResult = ["55"] }] - it ("parses a result line that only " - ++ "contains <BLANKLINE> as an empty line") $ do + it "can parse results if they don't have the same whitespace prefix" $ do + " >>> hey\n5\n 5\n 5" `shouldParseTo` + DocExamples [ Example { exampleExpression = "hey" + , exampleResult = ["5", "5", " 5"] }] + + + it "parses a <BLANKLINE> result as an empty result" $ do ">>> putFooBar\nfoo\n<BLANKLINE>\nbar" `shouldParseTo` DocExamples [Example "putFooBar" ["foo","","bar"]] @@ -235,11 +437,18 @@ spec = do "foobar\n\n> some code" `shouldParseTo` DocParagraph "foobar\n" <> DocCodeBlock " some code\n" - -- parse error - parseParas "foobar\n> some code" `shouldBe` Nothing + it "parses birdtracks inside of paragraphs as plain strings" $ do + "foobar\n> some code" `shouldParseTo` DocParagraph "foobar\n> some code\n" + + it "long birdtrack block without spaces in front" $ do + "beginning\n\n> foo\n> bar\n> baz" `shouldParseTo` + DocParagraph "beginning\n" + <> DocCodeBlock " foo\n bar\n baz\n" - it "consecutive birdtracks " $ do - ">test3\n>test4\n\n" `shouldParseTo` DocCodeBlock "test3\ntest4\n" + it "single DocCodeBlock even if there's space before birdtracks" $ do + "beginning\n\n > foo\n > bar\n > baz" `shouldParseTo` + DocParagraph "beginning\n" + <> DocCodeBlock " foo\n bar\n baz\n" it "consecutive birdtracks with spaces " $ do " > foo\n \n > bar\n \n" `shouldParseTo` @@ -247,72 +456,39 @@ spec = do it "code block + birdtracks" $ do "@\ntest1\ntest2\n@\n\n>test3\n>test4\n\n" `shouldParseTo` - DocCodeBlock "\ntest1\ntest2\n" <> DocCodeBlock "test3\ntest4\n" + DocCodeBlock "\ntest1\ntest2\n" + <> DocCodeBlock "test3\ntest4\n" - it "birdtracks + code block" $ do - ">test3\n>test4\n\n@\ntest1\ntest2\n@\n\n" `shouldParseTo` - DocCodeBlock "test3\ntest4\n" <> DocCodeBlock "\ntest1\ntest2\n" + it "requires the code block to be closed" $ do + "@hello" `shouldParseTo` DocParagraph "@hello\n" + it "preserves the first trailing whitespace after the opening @ in a code block" $ do + "@\ntest1\ntest2\n@" `shouldParseTo` DocCodeBlock "\ntest1\ntest2\n" + "@ \ntest1\ntest2\n@" `shouldParseTo` DocCodeBlock " \ntest1\ntest2\n" - it "can parse consecutive prompts with results" $ do - " >>> fib 5\n 5\n >>> fib 10\n 55" `shouldParseTo` - DocExamples [ Example { exampleExpression = "fib 5" - , exampleResult = ["5"] - } - , Example { exampleExpression = "fib 10" - , exampleResult = ["55"] - } - ] + it "markup in a @ code block" $ do + "@hello <world> \"Foo.Bar\" <<how is>> it /going/?@" `shouldParseTo` + DocCodeBlock + ("hello " <> + (DocHyperlink (Hyperlink {hyperlinkUrl = "world", hyperlinkLabel = Nothing})) + <> " " + <> DocModule "Foo.Bar" + <> " " + <> (DocPic (Picture {pictureUri = "how", pictureTitle = Just "is"})) + <> " it " <> (DocEmphasis "going") + <> "?") - context "when parsing a URL" $ do - it "parses a URL" $ do - "<http://example.com/>" `shouldParseTo` - (DocParagraph $ hyperlink "http://example.com/" Nothing <> "\n") + it "should allow us to escape the @ in a paragraph level @ code block" $ do + "@hello \\@ world@" `shouldParseTo` DocCodeBlock "hello @ world" - it "accepts an optional label" $ do - "<http://example.com/ some link>" `shouldParseTo` - (DocParagraph $ hyperlink "http://example.com/" "some link" <> "\n") - - it "consecutive URL and URL + label" $ do - (" \nA plain URL: <http://example.com/>\n\n A URL with a " - ++ "label: <http://example.com/ some link>") `shouldParseTo` - DocParagraph ( - "A plain URL: " <> - DocHyperlink (Hyperlink "http://example.com/" Nothing) <> "\n" - ) <> - DocParagraph ( - "A URL with a label: " <> - DocHyperlink (Hyperlink "http://example.com/" "some link") <> "\n" - ) - - it "finishes URL parsing as soon as it sees >, even if it's escaped" $ do - "<http://examp\\>le.com" `shouldParseTo` - DocParagraph ( - DocHyperlink (Hyperlink "http://examp\\" Nothing) <> "le.com\n" - ) + it "should swallow up trailing spaces in code blocks" $ do + "@ foo @" `shouldParseTo` DocCodeBlock " foo" - "<http://exa\\>mp\\>le.com>" `shouldParseTo` - DocParagraph ( - DocHyperlink (Hyperlink "http://exa\\" Nothing) <> "mp>le.com>\n" - ) - - -- Likewise in label - "<http://example.com f\\>oo>" `shouldParseTo` - DocParagraph ( - DocHyperlink (Hyperlink "http://example.com" "f\\") <> "oo>\n" - ) - - it "parses inline URLs" $ do - (" Not yet working, see <http://trac.haskell.org" - ++ "/haddock/ticket/223>\n , isEmptyChan") `shouldParseTo` - DocParagraph - ("Not yet working, see " - <> ((DocHyperlink - (Hyperlink { hyperlinkUrl = "http://trac.haskell.org" - ++ "/haddock/ticket/223" - , hyperlinkLabel = Nothing - })) <> "\n , isEmptyChan\n")) + it "birdtracks + code block" $ do + ">test3\n>test4\n\n@\ntest1\ntest2\n@\n\n" `shouldParseTo` + DocCodeBlock "test3\ntest4\n" + <> DocCodeBlock "\ntest1\ntest2\n" context "when parsing properties" $ do it "can parse a single property" $ do @@ -347,28 +523,28 @@ spec = do context "when parsing pictures" $ do it "parses a simple picture" $ do "<<baz>>" `shouldParseTo` - DocParagraph ((DocPic "baz") <> "\n") + DocParagraph (pic "baz" Nothing <> "\n") - it "parses a picture with spaces" $ do + it "parses a picture with a title" $ do "<<b a z>>" `shouldParseTo` - DocParagraph ((DocPic "b a z") <> "\n") + DocParagraph (pic "b" (Just "a z") <> "\n") it "parses a picture with unicode" $ do "<<灼眼のシャナ>>" `shouldParseTo` - DocParagraph ((DocPic "灼眼のシャナ") <> "\n") + DocParagraph ((pic "灼眼のシャナ" Nothing) <> "\n") it "doesn't allow for escaping of the closing tags" $ do -- bug? "<<ba\\>>z>>" `shouldParseTo` - (DocParagraph $ DocPic "ba\\" <> "z>>\n") + (DocParagraph $ pic "ba\\" Nothing <> "z>>\n") context "when parsing anchors" $ do it "should parse a single word anchor" $ do "#foo#" `shouldParseTo` - DocParagraph ((DocAName "foo") <> "\n") + DocParagraph (DocAName "foo" <> "\n") it "should parse a multi word anchor" $ do "#foo bar#" `shouldParseTo` - DocParagraph ((DocAName "foo bar") <> "\n") + DocParagraph (DocAName "foo bar" <> "\n") it "should parse a unicode anchor" $ do "#灼眼のシャナ#" `shouldParseTo` @@ -387,17 +563,18 @@ spec = do it "[@q/uu/x@] h\\ney" $ do "[@q/uu/x@] h\ney" `shouldParseTo` DocDefList - [(DocMonospaced - ((DocString "q") - <> ((DocEmphasis (DocString "uu")) - <> "x")), " h\ney\n")] - - it "[qu\\nx] hey" $ do - parseParas "[qu\nx] hey" `shouldBe` Nothing + [(DocMonospaced ("q" <> DocEmphasis "uu" <> "x"), " h\ney\n")] it "/qu\\nux/" $ do "/qu\nux/" `shouldParseTo` DocParagraph "/qu\nux/\n" + -- regression test + it "requires markup to be fully closed, even if nested" $ do + "@hel/lo" `shouldParseTo` DocParagraph "@hel/lo\n" + + it "will be total even if only the first delimiter is present" $ do + "/" `shouldParseTo` DocParagraph "/\n" + context "when parsing strings with apostrophes" $ do it "parses a word with an one of the delimiters in it as DocString" $ do "don't" `shouldParseTo` DocParagraph "don't\n" @@ -409,6 +586,39 @@ spec = do " don't use apostrophe's in the wrong place's" `shouldParseTo` DocParagraph "don't use apostrophe's in the wrong place's\n" + context "when parsing strings contaning numeric character references" $ do + it "will implicitly convert digits to characters" $ do + "AAAA" `shouldParseTo` DocParagraph "AAAA\n" + + "灼眼のシャナ" `shouldParseTo` + DocParagraph "灼眼のシャナ\n" + + it "will implicitly convert hex encoded characters" $ do + "eeee" `shouldParseTo` DocParagraph "eeee\n" + + context "when parsing module names" $ do + it "can accept a simple module name" $ do + "\"Hello\"" `shouldParseTo` DocParagraph (DocModule "Hello" <> "\n") + + it "can accept a module name with dots" $ do + "\"Hello.World\"" `shouldParseTo` DocParagraph (DocModule "Hello.World" <> "\n") + + it "can accept a module name with unicode" $ do + "\"Hello.Worldλ\"" `shouldParseTo` DocParagraph ((DocModule "Hello.Worldλ") <> "\n") + + it "parses a module name with a trailing dot as regular quoted string" $ do + "\"Hello.\"" `shouldParseTo` DocParagraph "\"Hello.\"\n" + + it "parses a module name with a space as regular quoted string" $ do + "\"Hello World\"" `shouldParseTo` DocParagraph "\"Hello World\"\n" + + it "parses a module name with invalid characters as regular quoted string" $ do + "\"Hello&[{}(=*)+]!\"" `shouldParseTo` DocParagraph "\"Hello&[{}(=*)+]!\"\n" + + where hyperlink :: String -> Maybe String -> Doc RdrName hyperlink url = DocHyperlink . Hyperlink url + + pic :: String -> Maybe String -> Doc RdrName + pic uri = DocPic . Picture uri diff --git a/test/Haddock/Utf8Spec.hs b/test/Haddock/Utf8Spec.hs new file mode 100644 index 00000000..a352bf61 --- /dev/null +++ b/test/Haddock/Utf8Spec.hs @@ -0,0 +1,15 @@ +module Haddock.Utf8Spec (main, spec) where + +import Test.Hspec +import Test.QuickCheck + +import Haddock.Utf8 + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "decodeUtf8" $ do + it "is inverse to encodeUtf8" $ do + property $ \xs -> (decodeUtf8 . encodeUtf8) xs `shouldBe` xs |