diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/Haddock/ParseSpec.hs | 381 |
1 files changed, 358 insertions, 23 deletions
diff --git a/test/Haddock/ParseSpec.hs b/test/Haddock/ParseSpec.hs index d692cb0c..4713c60b 100644 --- a/test/Haddock/ParseSpec.hs +++ b/test/Haddock/ParseSpec.hs @@ -1,16 +1,21 @@ -{-# LANGUAGE OverloadedStrings, StandaloneDeriving, FlexibleInstances, UndecidableInstances, IncoherentInstances #-} +{-# LANGUAGE OverloadedStrings, StandaloneDeriving + , FlexibleInstances, UndecidableInstances + , IncoherentInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + module Haddock.ParseSpec (main, spec) where -import Test.Hspec -import RdrName (RdrName) +import Control.Applicative +import Data.Monoid +import Data.String import DynFlags (DynFlags, defaultDynFlags) +import Haddock.Doc (combineStringNodes) import Haddock.Lex (tokenise) import qualified Haddock.Parse as Parse import Haddock.Types import Outputable (Outputable, showSDoc, ppr) -import Data.Monoid -import Data.String +import RdrName (RdrName) +import Test.Hspec dynFlags :: DynFlags dynFlags = defaultDynFlags (error "dynFlags for Haddock tests: undefined") @@ -19,63 +24,393 @@ instance Outputable a => Show a where show = showSDoc dynFlags . ppr deriving instance Show a => Show (Doc a) -deriving instance Eq a =>Eq (Doc a) +deriving instance Eq a => Eq (Doc a) + instance IsString (Doc RdrName) where fromString = DocString +instance IsString a => IsString (Maybe a) where + fromString = Just . fromString + parseParas :: String -> Maybe (Doc RdrName) parseParas s = Parse.parseParas $ tokenise dynFlags s (0,0) +parseString :: String -> Maybe (Doc RdrName) +parseString s = Parse.parseString $ tokenise dynFlags s (0,0) + 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 describe "parseParas" $ do it "parses a paragraph" $ do - parseParas "foobar" `shouldBe` Just (DocParagraph "foobar\n") + "foobar" `shouldParseTo` DocParagraph "foobar\n" + + context "when parsing a simple string" $ do + it "] should be made into a DocString" $ do + "hell]o" `shouldParseTo` DocParagraph "hell]o\n" + + it "can handle unicode" $ do + "灼眼のシャナ" `shouldParseTo` DocParagraph "灼眼のシャナ\n" + + context "when parsing module strings" $ do + it "should parse a module on its own" $ do + "\"Module\"" `shouldParseTo` + (DocParagraph $ DocModule "Module" <> "\n") + + it "should parse a module inline" $ do + "This is a \"Module\"." `shouldParseTo` + DocParagraph ("This is a " <> ((DocModule "Module") <> ".\n")) + + context "when parsing emphasised strings" $ do + it "emphasises a word on its own" $ do + "/quux/" `shouldParseTo` (DocParagraph $ DocEmphasis "quux" <> "\n") + + it "emphasises inline correctly" $ do + "This comment applies to the /following/ declaration" `shouldParseTo` + (DocParagraph $ "This comment applies to the " + <> DocEmphasis "following" <> " declaration\n") + + it "emphasises unicode" $ do + "/灼眼のシャナ/" `shouldParseTo` + (DocParagraph $ DocEmphasis "灼眼のシャナ" <> "\n") + + it "does /multi-line\\n codeblocks/" $ do + " /multi-line\n emphasis/" `shouldParseTo` + DocParagraph "/multi-line\n emphasis/\n" + + context "when parsing codeblocks" $ do + it "codeblock a word on its own" $ do + "@quux@" `shouldParseTo` DocCodeBlock "quux" + + it "codeblocks unicode" $ do + "@灼眼のシャナ@" `shouldParseTo` DocCodeBlock "灼眼のシャナ" + + + it "does @multi-line\\n codeblocks@" $ do + "@multi-line\n codeblocks@" `shouldParseTo` + DocCodeBlock "multi-line\n codeblocks" + + it "accepts other elements in a codeblock" $ do + "@/emphasis/ \"Module\" <<picture>>@" `shouldParseTo` + (DocCodeBlock $ DocEmphasis "emphasis" <> " " + <> DocModule "Module" <> " " <> DocPic "picture") + + context "when parsing monospaced strings" $ do + it "monospaces inline strings" $ do + "This comment applies to the @following@ declaration" `shouldParseTo` + (DocParagraph $ "This comment applies to the " + <> DocMonospaced "following" <> " declaration\n") + + it "monospaces inline unicode" $ do + "hello @灼眼のシャナ@ unicode" `shouldParseTo` + (DocParagraph $ "hello " + <> DocMonospaced "灼眼のシャナ" <> " unicode\n") + + 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") + + + 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"] + + it "parses an empty unordered list" $ do + "*" `shouldParseTo` DocUnorderedList [DocParagraph "\n"] + + it "accepts unicode in an unordered list" $ do + "* 灼眼のシャナ" `shouldParseTo` + DocUnorderedList [DocParagraph " 灼眼のシャナ\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` + 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" + ] + + it "parses an empty list" $ do + "1." `shouldParseTo` DocOrderedList [DocParagraph "\n"] + + "(1)" `shouldParseTo` DocOrderedList [DocParagraph "\n"] + + it "accepts unicode" $ do + "1. 灼眼のシャナ" `shouldParseTo` + DocOrderedList [DocParagraph " 灼眼のシャナ\n"] + + "(1) 灼眼のシャナ" `shouldParseTo` + DocOrderedList [DocParagraph " 灼眼のシャナ\n"] + + it "accepts other elements" $ do + ("1. \"Module\"\n\n2. /emphasis/" + ++ "\n\n3. @code@\n\n4. a@mono@b \n\n5.") `shouldParseTo` + DocOrderedList [ + DocParagraph (" " <> DocModule "Module" <> "\n") + , DocParagraph (" " <> DocEmphasis "emphasis" <> "\n") + , DocCodeBlock "code" + , DocParagraph (" a" <> DocMonospaced "mono" <> "b \n") + , DocParagraph "\n" + ] + + context "when parsing definition lists" $ do + it "parses a simple list" $ do + "[foo] bar\n\n[baz] quux" `shouldParseTo` + DocDefList [("foo", " bar\n"), ("baz", " quux\n")] + + it "parses a list with unicode in it" $ do + "[灼眼] シャナ" `shouldParseTo` + DocDefList [("灼眼", " シャナ\n")] + + it "parse other markup inside of it as usual" $ do + "[/foo/] bar" `shouldParseTo` + DocDefList [(DocEmphasis "foo", " bar\n")] + + it "doesn't need a string to follow it" $ do + "[hello /world/]" `shouldParseTo` + DocDefList [("hello " <> DocEmphasis "world", "\n")] + + it "takes input until the very last delimiter on the line" $ do + "[[world]] bar" `shouldParseTo` + DocDefList [("[world", "] bar\n")] context "when parsing an example" $ do - it "requires an example to be separated from a previous paragrap by an empty line" $ do - parseParas "foobar\n\n>>> fib 10\n55" `shouldBe` - Just (DocParagraph "foobar\n" <> DocExamples [Example "fib 10" ["55"]]) + it ("requires an example to be separated" + ++ " from a previous paragraph by an empty line") $ do + "foobar\n\n>>> fib 10\n55" `shouldParseTo` + DocParagraph "foobar\n" + <> DocExamples [Example "fib 10" ["55"]] -- parse error parseParas "foobar\n>>> fib 10\n55" `shouldBe` Nothing - it "parses a result line that only contains <BLANKLINE> as an emptly line" $ do - parseParas ">>> putFooBar\nfoo\n<BLANKLINE>\nbar" `shouldBe` - Just (DocExamples [Example "putFooBar" ["foo","","bar"]]) + it "parses a prompt with no example results" $ do + " >>> import Data.Char\n " `shouldParseTo` + DocExamples [ Example { exampleExpression = "import Data.Char" + , exampleResult = [] + } + ] + + it "is able to parse example sections with unicode" $ do + " >>> 灼眼\n の\n >>> シャナ\n 封絶" `shouldParseTo` + DocExamples [ Example { exampleExpression = "灼眼" + , exampleResult = ["の"] + } + , Example { exampleExpression = "シャナ" + , exampleResult = ["封絶"] + } + ] + + it ("parses a result line that only " + ++ "contains <BLANKLINE> as an empty line") $ do + ">>> putFooBar\nfoo\n<BLANKLINE>\nbar" `shouldParseTo` + DocExamples [Example "putFooBar" ["foo","","bar"]] context "when parsing a code block" $ do - it "requires a code blocks to be separated from a previous paragrap by an empty line" $ do - parseParas "foobar\n\n> some code" `shouldBe` - Just (DocParagraph "foobar\n" <> DocCodeBlock " some code\n") + it ("requires a code blocks to be " + ++ "separated from a previous paragraph by an empty line") $ do + "foobar\n\n> some code" `shouldParseTo` + DocParagraph "foobar\n" <> DocCodeBlock " some code\n" -- parse error parseParas "foobar\n> some code" `shouldBe` Nothing + it "consecutive birdtracks " $ do + ">test3\n>test4\n\n" `shouldParseTo` DocCodeBlock "test3\ntest4\n" + + it "consecutive birdtracks with spaces " $ do + " > foo\n \n > bar\n \n" `shouldParseTo` + DocCodeBlock " foo\n" <> DocCodeBlock " bar\n" + + it "code block + birdtracks" $ do + "@\ntest1\ntest2\n@\n\n>test3\n>test4\n\n" `shouldParseTo` + 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 "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"] + } + ] context "when parsing a URL" $ do it "parses a URL" $ do - parseParas "<http://example.com/>" `shouldBe` - Just (DocParagraph $ hyperlink "http://example.com/" Nothing <> "\n") + "<http://example.com/>" `shouldParseTo` + (DocParagraph $ hyperlink "http://example.com/" Nothing <> "\n") it "accepts an optional label" $ do - parseParas "<http://example.com/ some link>" `shouldBe` - Just (DocParagraph $ hyperlink "http://example.com/" (Just "some link") <> "\n") + "<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" + ) + + "<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")) context "when parsing properties" $ do it "can parse a single property" $ do - parseParas "prop> 23 == 23" `shouldBe` Just (DocProperty "23 == 23") + "prop> 23 == 23" `shouldParseTo` DocProperty "23 == 23" it "can parse multiple subsequent properties" $ do - parseParas $ unlines [ + unlines [ "prop> 23 == 23" , "prop> 42 == 42" ] - `shouldBe` Just (DocProperty "23 == 23" <> DocProperty "42 == 42") + `shouldParseTo` + DocProperty "23 == 23" <> DocProperty "42 == 42" + + it "accepts unicode in properties" $ do + "prop> 灼眼のシャナ ≡ 愛" `shouldParseTo` + DocProperty "灼眼のシャナ ≡ 愛" + + it "can deal with whitespace before and after the prop> prompt" $ do + " prop> xs == (reverse $ reverse xs)" `shouldParseTo` + DocProperty "xs == (reverse $ reverse xs)" + + context "when escaping elements" $ do + + it "escapes \\#\\#\\#" $ do + " We should be able to escape this: \\#\\#\\#" `shouldParseTo` + DocParagraph "We should be able to escape this: ###\n" + + it "escapes forward slashes" $ do + " Existential \\/ Universal types" `shouldParseTo` + DocParagraph "Existential / Universal types\n" + + context "when parsing pictures" $ do + it "parses a simple picture" $ do + "<<baz>>" `shouldParseTo` + DocParagraph ((DocPic "baz") <> "\n") + + it "parses a picture with spaces" $ do + "<<b a z>>" `shouldParseTo` + DocParagraph ((DocPic "b a z") <> "\n") + + it "parses a picture with unicode" $ do + "<<灼眼のシャナ>>" `shouldParseTo` + DocParagraph ((DocPic "灼眼のシャナ") <> "\n") + + it "doesn't allow for escaping of the closing tags" $ do -- bug? + "<<ba\\>>z>>" `shouldParseTo` + (DocParagraph $ DocPic "ba\\" <> "z>>\n") + + context "when parsing anchors" $ do + it "should parse a single word anchor" $ do + "#foo#" `shouldParseTo` + DocParagraph ((DocAName "foo") <> "\n") + + it "should parse a multi word anchor" $ do + "#foo bar#" `shouldParseTo` + DocParagraph ((DocAName "foo bar") <> "\n") + + it "should parse a unicode anchor" $ do + "#灼眼のシャナ#" `shouldParseTo` + DocParagraph (DocAName "灼眼のシャナ" <> "\n") + + context "replicates parsing of weird strings" $ do + it "#f\\noo#" $ do + "#f\noo#" `shouldParseTo` DocParagraph "#f\noo#\n" + + it "<b\\nar>" $ do + "<b\nar>" `shouldParseTo` DocParagraph "<b\nar>\n" + + it "<<ba\\nz aar>>" $ do + "<<ba\nz aar>>" `shouldParseTo` DocParagraph "<<ba\nz aar>>\n" + + 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 + + it "/qu\\nux/" $ do + "/qu\nux/" `shouldParseTo` DocParagraph "/qu\nux/\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" + + it "doesn't pass pairs of delimiters with spaces between them" $ do + "hel'lo w'orld" `shouldParseTo` DocParagraph "hel'lo w'orld\n" + + it "don't use apostrophe's in the wrong place's" $ do + " don't use apostrophe's in the wrong place's" `shouldParseTo` + DocParagraph "don't use apostrophe's in the wrong place's\n" + where hyperlink :: String -> Maybe String -> Doc RdrName hyperlink url = DocHyperlink . Hyperlink url |