diff options
Diffstat (limited to 'haddock-library/test/Documentation')
3 files changed, 852 insertions, 0 deletions
diff --git a/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs b/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs new file mode 100644 index 00000000..265a4d49 --- /dev/null +++ b/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} +module Documentation.Haddock.Parser.UtilSpec (main, spec) where + +import Data.Attoparsec.ByteString.Char8 +import Data.Either +import Documentation.Haddock.Parser.Util +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "takeUntil" $ do + it "takes everything until a specified byte sequence" $ do + parseOnly (takeUntil "end") "someend" `shouldBe` Right "some" + + it "requires the end sequence" $ do + parseOnly (takeUntil "end") "someen" `shouldSatisfy` isLeft + + it "takes escaped bytes unconditionally" $ do + parseOnly (takeUntil "end") "some\\endend" `shouldBe` Right "some\\end" diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs new file mode 100644 index 00000000..3889d555 --- /dev/null +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -0,0 +1,816 @@ +{-# LANGUAGE OverloadedStrings, StandaloneDeriving + , FlexibleInstances, UndecidableInstances + , IncoherentInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Documentation.Haddock.ParserSpec (main, spec) where + +import Data.Monoid +import Data.String +import qualified Documentation.Haddock.Parser as Parse +import Documentation.Haddock.Types +import Test.Hspec +import Test.QuickCheck + +type Doc id = DocH () id + +deriving instance Show a => Show (Header a) +deriving instance Show a => Show (Doc a) +deriving instance Eq a => Eq (Header a) +deriving instance Eq a => Eq (Doc a) + +instance IsString (Doc String) where + fromString = DocString + +instance IsString a => IsString (Maybe a) where + fromString = Just . fromString + +parseParas :: String -> Doc String +parseParas = Parse.toRegular . Parse.parseParas + +parseString :: String -> Doc String +parseString = Parse.toRegular . Parse.parseString + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "parseString" $ do + let infix 1 `shouldParseTo` + shouldParseTo :: String -> Doc String -> Expectation + shouldParseTo input ast = parseString input `shouldBe` ast + + it "is total" $ do + property $ \xs -> + (length . show . parseString) xs `shouldSatisfy` (> 0) + + context "when parsing text" $ do + it "can handle unicode" $ do + "灼眼のシャナ" `shouldParseTo` "灼眼のシャナ" + + it "accepts numeric character references" $ do + "foo bar baz λ" `shouldParseTo` "foo bar baz λ" + + it "accepts hexadecimal character references" $ do + "e" `shouldParseTo` "e" + + it "allows to backslash-escape characters" $ do + property $ \x -> ['\\', x] `shouldParseTo` DocString [x] + + context "when parsing strings contaning numeric character references" $ do + it "will implicitly convert digits to characters" $ do + "AAAA" `shouldParseTo` "AAAA" + + "灼眼のシャナ" + `shouldParseTo` "灼眼のシャナ" + + it "will implicitly convert hex encoded characters" $ do + "eeee" `shouldParseTo` "eeee" + + context "when parsing identifiers" $ do + it "parses identifiers enclosed within single ticks" $ do + "'foo'" `shouldParseTo` DocIdentifier "foo" + + it "parses identifiers enclosed within backticks" $ do + "`foo`" `shouldParseTo` DocIdentifier "foo" + + it "parses a word with an one of the delimiters in it as DocString" $ do + "don't" `shouldParseTo` "don't" + + it "doesn't pass pairs of delimiters with spaces between them" $ do + "hel'lo w'orld" `shouldParseTo` "hel'lo w'orld" + + it "don't use apostrophe's in the wrong place's" $ do + " don't use apostrophe's in the wrong place's" `shouldParseTo` + "don't use apostrophe's in the wrong place's" + + context "when parsing URLs" $ do + let hyperlink :: String -> Maybe String -> Doc String + hyperlink url = DocHyperlink . Hyperlink url + + it "parses a URL" $ do + "<http://example.com/>" `shouldParseTo` hyperlink "http://example.com/" Nothing + + it "accepts an optional label" $ do + "<http://example.com/ some link>" `shouldParseTo` hyperlink "http://example.com/" "some link" + + it "does not accept newlines in label" $ do + "<foo bar\nbaz>" `shouldParseTo` "<foo bar\nbaz>" + + -- new behaviour test, this will be now consistent with other markup + it "allows us to escape > inside the URL" $ do + "<http://examp\\>le.com>" `shouldParseTo` + hyperlink "http://examp>le.com" Nothing + + "<http://exa\\>mp\\>le.com>" `shouldParseTo` + hyperlink "http://exa>mp>le.com" Nothing + + -- Likewise in label + "<http://example.com f\\>oo>" `shouldParseTo` + hyperlink "http://example.com" "f>oo" + + it "parses inline URLs" $ do + "foo <http://example.com/> bar" `shouldParseTo` + "foo " <> hyperlink "http://example.com/" Nothing <> " bar" + + it "doesn't allow for multi-line link tags" $ do + "<ba\nz aar>" `shouldParseTo` "<ba\nz aar>" + + context "when autolinking URLs" $ do + it "autolinks HTTP URLs" $ do + "http://example.com/" `shouldParseTo` hyperlink "http://example.com/" Nothing + + it "autolinks HTTPS URLs" $ do + "https://www.example.com/" `shouldParseTo` hyperlink "https://www.example.com/" Nothing + + it "autolinks FTP URLs" $ do + "ftp://example.com/" `shouldParseTo` hyperlink "ftp://example.com/" Nothing + + it "does not include a trailing comma" $ do + "http://example.com/, Some other sentence." `shouldParseTo` + hyperlink "http://example.com/" Nothing <> ", Some other sentence." + + it "does not include a trailing dot" $ do + "http://example.com/. Some other sentence." `shouldParseTo` + hyperlink "http://example.com/" Nothing <> ". Some other sentence." + + it "does not include a trailing exclamation mark" $ do + "http://example.com/! Some other sentence." `shouldParseTo` + hyperlink "http://example.com/" Nothing <> "! Some other sentence." + + it "does not include a trailing question mark" $ do + "http://example.com/? Some other sentence." `shouldParseTo` + hyperlink "http://example.com/" Nothing <> "? Some other sentence." + + context "when parsing pictures" $ do + let picture :: String -> Maybe String -> Doc String + picture uri = DocPic . Picture uri + + it "parses a simple picture" $ do + "<<baz>>" `shouldParseTo` picture "baz" Nothing + + it "parses a picture with a title" $ do + "<<b a z>>" `shouldParseTo` picture "b" (Just "a z") + + it "parses a picture with unicode" $ do + "<<灼眼のシャナ>>" `shouldParseTo` picture "灼眼のシャナ" Nothing + + it "allows for escaping of the closing tags" $ do + "<<ba\\>>z>>" `shouldParseTo` picture "ba>>z" Nothing + + it "doesn't allow for multi-line picture tags" $ do + "<<ba\nz aar>>" `shouldParseTo` "<<ba\nz aar>>" + + context "when parsing anchors" $ do + it "parses a single word anchor" $ do + "#foo#" `shouldParseTo` DocAName "foo" + + it "parses a multi word anchor" $ do + "#foo bar#" `shouldParseTo` DocAName "foo bar" + + it "parses a unicode anchor" $ do + "#灼眼のシャナ#" `shouldParseTo` DocAName "灼眼のシャナ" + + it "does not accept newlines in anchors" $ do + "#foo\nbar#" `shouldParseTo` "#foo\nbar#" + + context "when parsing emphasised text" $ do + it "emphasises a word on its own" $ do + "/foo/" `shouldParseTo` DocEmphasis "foo" + + it "emphasises inline correctly" $ do + "foo /bar/ baz" `shouldParseTo` "foo " <> DocEmphasis "bar" <> " baz" + + it "emphasises unicode" $ do + "/灼眼のシャナ/" `shouldParseTo` DocEmphasis "灼眼のシャナ" + + it "does not emphasise multi-line strings" $ do + " /foo\nbar/" `shouldParseTo` "/foo\nbar/" + + it "does not emphasise the empty string" $ do + "//" `shouldParseTo` "//" + + it "parses escaped slashes literally" $ do + "/foo\\/bar/" `shouldParseTo` DocEmphasis "foo/bar" + + it "recognizes other markup constructs within emphasised text" $ do + "/foo @bar@ baz/" `shouldParseTo` + DocEmphasis ("foo " <> DocMonospaced "bar" <> " baz") + + it "allows other markup inside of emphasis" $ do + "/__inner bold__/" `shouldParseTo` DocEmphasis (DocBold "inner bold") + + it "doesn't mangle inner markup unicode" $ do + "/__灼眼のシャナ A__/" `shouldParseTo` DocEmphasis (DocBold "灼眼のシャナ A") + + it "properly converts HTML escape sequences" $ do + "/AAAA/" `shouldParseTo` DocEmphasis "AAAA" + + it "allows to escape the emphasis delimiter inside of emphasis" $ do + "/empha\\/sis/" `shouldParseTo` DocEmphasis "empha/sis" + + context "when parsing monospaced text" $ do + it "parses simple monospaced text" $ do + "@foo@" `shouldParseTo` DocMonospaced "foo" + + it "parses inline monospaced text" $ do + "foo @bar@ baz" `shouldParseTo` "foo " <> DocMonospaced "bar" <> " baz" + + it "allows to escape @" $ do + "@foo \\@ bar@" `shouldParseTo` DocMonospaced "foo @ bar" + + it "accepts unicode" $ do + "@foo 灼眼のシャナ bar@" `shouldParseTo` DocMonospaced "foo 灼眼のシャナ bar" + + it "accepts other markup in monospaced text" $ do + "@/foo/@" `shouldParseTo` DocMonospaced (DocEmphasis "foo") + + it "requires the closing @" $ do + "@foo /bar/ baz" `shouldParseTo` "@foo " <> DocEmphasis "bar" <> " baz" + + context "when parsing bold strings" $ do + it "allows for a bold string on its own" $ do + "__bold string__" `shouldParseTo` + DocBold "bold string" + + it "bolds inline correctly" $ do + "hello __everyone__ there" `shouldParseTo` + "hello " + <> DocBold "everyone" <> " there" + + it "bolds unicode" $ do + "__灼眼のシャナ__" `shouldParseTo` + DocBold "灼眼のシャナ" + + it "does not do __multi-line\\n bold__" $ do + " __multi-line\n bold__" `shouldParseTo` "__multi-line\n bold__" + + it "allows other markup inside of bold" $ do + "__/inner emphasis/__" `shouldParseTo` + (DocBold $ DocEmphasis "inner emphasis") + + it "doesn't mangle inner markup unicode" $ do + "__/灼眼のシャナ A/__" `shouldParseTo` + (DocBold $ DocEmphasis "灼眼のシャナ A") + + it "properly converts HTML escape sequences" $ do + "__AAAA__" `shouldParseTo` + DocBold "AAAA" + + it "allows to escape the bold delimiter inside of bold" $ do + "__bo\\__ld__" `shouldParseTo` + DocBold "bo__ld" + + it "doesn't allow for empty bold" $ do + "____" `shouldParseTo` "____" + + context "when parsing module strings" $ do + it "should parse a module on its own" $ do + "\"Module\"" `shouldParseTo` + DocModule "Module" + + it "should parse a module inline" $ do + "This is a \"Module\"." `shouldParseTo` + "This is a " <> DocModule "Module" <> "." + + it "can accept a simple module name" $ do + "\"Hello\"" `shouldParseTo` DocModule "Hello" + + it "can accept a module name with dots" $ do + "\"Hello.World\"" `shouldParseTo` DocModule "Hello.World" + + it "can accept a module name with unicode" $ do + "\"Hello.Worldλ\"" `shouldParseTo` DocModule "Hello.Worldλ" + + it "parses a module name with a trailing dot as regular quoted string" $ do + "\"Hello.\"" `shouldParseTo` "\"Hello.\"" + + it "parses a module name with a space as regular quoted string" $ do + "\"Hello World\"" `shouldParseTo` "\"Hello World\"" + + it "parses a module name with invalid characters as regular quoted string" $ do + "\"Hello&[{}(=*)+]!\"" `shouldParseTo` "\"Hello&[{}(=*)+]!\"" + + it "accepts a module name with unicode" $ do + "\"Foo.Barλ\"" `shouldParseTo` DocModule "Foo.Barλ" + + it "treats empty module name as regular double quotes" $ do + "\"\"" `shouldParseTo` "\"\"" + + describe "parseParas" $ do + let infix 1 `shouldParseTo` + shouldParseTo :: String -> Doc String -> Expectation + shouldParseTo input ast = parseParas input `shouldBe` ast + + it "is total" $ do + property $ \xs -> + (length . show . parseParas) xs `shouldSatisfy` (> 0) + + context "when parsing text paragraphs" $ do + let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String)) + + it "parses an empty paragraph" $ do + "" `shouldParseTo` DocEmpty + + it "parses a simple text paragraph" $ do + "foo bar baz" `shouldParseTo` DocParagraph "foo bar baz" + + it "accepts markup in text paragraphs" $ do + "foo /bar/ baz" `shouldParseTo` DocParagraph ("foo " <> DocEmphasis "bar" <> " baz") + + it "preserve all regular characters" $ do + property $ \xs -> let input = filterSpecial xs in (not . null) input ==> + input `shouldParseTo` DocParagraph (DocString input) + + it "separates paragraphs by empty lines" $ do + unlines [ + "foo" + , " \t " + , "bar" + ] `shouldParseTo` DocParagraph "foo" <> DocParagraph "bar" + + context "when a pragraph only contains monospaced text" $ do + it "turns it into a code block" $ do + "@foo@" `shouldParseTo` DocCodeBlock "foo" + + context "when parsing birdtracks" $ do + it "parses them as a code block" $ do + unlines [ + ">foo" + , ">bar" + , ">baz" + ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" + + it "ignores leading whitespace" $ do + unlines [ + " >foo" + , " \t >bar" + , " >baz" + ] + `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" + + it "strips one leading space from each line of the block" $ do + unlines [ + "> foo" + , "> bar" + , "> baz" + ] `shouldParseTo` DocCodeBlock "foo\n bar\nbaz" + + it "ignores empty lines when stripping spaces" $ do + unlines [ + "> foo" + , ">" + , "> bar" + ] `shouldParseTo` DocCodeBlock "foo\n\nbar" + + context "when any non-empty line does not start with a space" $ do + it "does not strip any spaces" $ do + unlines [ + ">foo" + , "> bar" + ] `shouldParseTo` DocCodeBlock "foo\n bar" + + it "ignores nested markup" $ do + unlines [ + ">/foo/" + ] `shouldParseTo` DocCodeBlock "/foo/" + + it "treats them as regular text inside text paragraphs" $ do + unlines [ + "foo" + , ">bar" + ] `shouldParseTo` DocParagraph "foo\n>bar" + + context "when parsing code blocks" $ do + it "accepts a simple code block" $ do + unlines [ + "@" + , "foo" + , "bar" + , "baz" + , "@" + ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz\n" + + it "ignores trailing whitespace after the opening @" $ do + unlines [ + "@ " + , "foo" + , "@" + ] `shouldParseTo` DocCodeBlock "foo\n" + + it "rejects code blocks that are not closed" $ do + unlines [ + "@" + , "foo" + ] `shouldParseTo` DocParagraph "@\nfoo" + + it "accepts nested markup" $ do + unlines [ + "@" + , "/foo/" + , "@" + ] `shouldParseTo` DocCodeBlock (DocEmphasis "foo" <> "\n") + + it "allows to escape the @" $ do + unlines [ + "@" + , "foo" + , "\\@" + , "bar" + , "@" + ] `shouldParseTo` DocCodeBlock "foo\n@\nbar\n" + + it "accepts horizontal space before the @" $ do + unlines [ " @" + , "foo" + , "" + , "bar" + , "@" + ] `shouldParseTo` DocCodeBlock "foo\n\nbar\n" + + it "strips a leading space from a @ block if present" $ do + unlines [ " @" + , " hello" + , " world" + , " @" + ] `shouldParseTo` DocCodeBlock "hello\nworld\n" + + unlines [ " @" + , " hello" + , "" + , " world" + , " @" + ] `shouldParseTo` DocCodeBlock "hello\n\nworld\n" + + it "only drops whitespace if there's some before closing @" $ do + unlines [ "@" + , " Formatting" + , " matters." + , "@" + ] + `shouldParseTo` DocCodeBlock " Formatting\n matters.\n" + + it "accepts unicode" $ do + "@foo 灼眼のシャナ bar@" `shouldParseTo` DocCodeBlock "foo 灼眼のシャナ bar" + + it "requires the closing @" $ do + "@foo /bar/ baz" + `shouldParseTo` DocParagraph ("@foo " <> DocEmphasis "bar" <> " baz") + + + context "when parsing examples" $ do + it "parses a simple example" $ do + ">>> foo" `shouldParseTo` DocExamples [Example "foo" []] + + it "parses an example with result" $ do + unlines [ + ">>> foo" + , "bar" + , "baz" + ] `shouldParseTo` DocExamples [Example "foo" ["bar", "baz"]] + + it "parses consecutive examples" $ do + unlines [ + ">>> fib 5" + , "5" + , ">>> fib 10" + , "55" + ] `shouldParseTo` DocExamples [ + Example "fib 5" ["5"] + , 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" + <> DocExamples [Example "fib 10" ["55"]] + + it "parses bird-tracks inside of paragraphs as plain strings" $ do + let xs = "foo\n>>> bar" + xs `shouldParseTo` DocParagraph (DocString xs) + + it "skips empty lines in front of an example" $ do + "\n \n\n>>> foo" `shouldParseTo` DocExamples [Example "foo" []] + + it "terminates example on empty line" $ do + unlines [ + ">>> foo" + , "bar" + , " " + , "baz" + ] + `shouldParseTo` + DocExamples [Example "foo" ["bar"]] <> DocParagraph "baz" + + it "parses a <BLANKLINE> result as an empty result" $ do + unlines [ + ">>> foo" + , "bar" + , "<BLANKLINE>" + , "baz" + ] + `shouldParseTo` DocExamples [Example "foo" ["bar", "", "baz"]] + + it "accepts unicode in examples" $ do + ">>> 灼眼\nシャナ" `shouldParseTo` DocExamples [Example "灼眼" ["シャナ"]] + + context "when prompt is prefixed by whitespace" $ do + it "strips the exact same amount of whitespace from result lines" $ do + unlines [ + " >>> foo" + , " bar" + , " baz" + ] `shouldParseTo` DocExamples [Example "foo" ["bar", "baz"]] + + it "preserves additional whitespace" $ do + unlines [ + " >>> foo" + , " bar" + ] `shouldParseTo` DocExamples [Example "foo" [" bar"]] + + it "keeps original if stripping is not possible" $ do + unlines [ + " >>> foo" + , " bar" + ] `shouldParseTo` DocExamples [Example "foo" [" bar"]] + + + context "when parsing paragraphs nested in lists" $ do + it "can nest the same type of list" $ do + "* foo\n\n * bar" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocUnorderedList [DocParagraph "bar"]] + + it "can nest another type of list inside" $ do + "* foo\n\n 1. bar" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocOrderedList [DocParagraph "bar"]] + + it "can nest a code block inside" $ do + "* foo\n\n @foo bar baz@" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocCodeBlock "foo bar baz"] + + "* foo\n\n @\n foo bar baz\n @" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocCodeBlock "foo bar baz\n"] + + it "can nest more than one level" $ do + "* foo\n\n * bar\n\n * baz\n qux" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocUnorderedList [ DocParagraph $ "bar" + <> DocUnorderedList [DocParagraph "baz\nqux"] + ] + ] + + it "won't fail on not fully indented paragraph" $ do + "* foo\n\n * bar\n\n * qux\nquux" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocUnorderedList [ DocParagraph "bar" ] + , DocParagraph "qux\nquux"] + + + it "can nest definition lists" $ do + "[a] foo\n\n [b] bar\n\n [c] baz\n qux" `shouldParseTo` + DocDefList [ ("a", "foo" + <> DocDefList [ ("b", "bar" + <> DocDefList [("c", "baz\nqux")]) + ]) + ] + + it "can come back to top level with a different list" $ do + "* foo\n\n * bar\n\n1. baz" `shouldParseTo` + DocUnorderedList [ DocParagraph $ "foo" + <> DocUnorderedList [ DocParagraph "bar" ] + ] + <> DocOrderedList [ DocParagraph "baz" ] + + it "definition lists can come back to top level with a different list" $ do + "[foo] foov\n\n [bar] barv\n\n1. baz" `shouldParseTo` + DocDefList [ ("foo", "foov" + <> DocDefList [ ("bar", "barv") ]) + ] + <> DocOrderedList [ DocParagraph "baz" ] + + context "when parsing properties" $ do + it "can parse a single property" $ do + "prop> 23 == 23" `shouldParseTo` DocProperty "23 == 23" + + it "can parse multiple subsequent properties" $ do + unlines [ + "prop> 23 == 23" + , "prop> 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 parsing unordered lists" $ do + it "parses a simple list" $ do + unlines [ + " * one" + , " * two" + , " * three" + ] + `shouldParseTo` DocUnorderedList [ + DocParagraph "one" + , DocParagraph "two" + , DocParagraph "three" + ] + + it "ignores empty lines between list items" $ do + unlines [ + "* one" + , "" + , "* two" + ] + `shouldParseTo` DocUnorderedList [ + DocParagraph "one" + , DocParagraph "two" + ] + + it "accepts an empty list item" $ do + "*" `shouldParseTo` DocUnorderedList [DocParagraph DocEmpty] + + it "accepts multi-line list items" $ do + unlines [ + "* point one" + , " more one" + , "* point two" + , "more two" + ] + `shouldParseTo` DocUnorderedList [ + DocParagraph "point one\n more one" + , DocParagraph "point two\nmore two" + ] + + it "accepts markup in list items" $ do + "* /foo/" `shouldParseTo` DocUnorderedList [DocParagraph (DocEmphasis "foo")] + + it "requires empty lines between list and other paragraphs" $ do + unlines [ + "foo" + , "" + , "* bar" + , "" + , "baz" + ] + `shouldParseTo` DocParagraph "foo" <> DocUnorderedList [DocParagraph "bar"] <> DocParagraph "baz" + + context "when parsing ordered lists" $ do + it "parses a simple list" $ do + unlines [ + " 1. one" + , " (1) two" + , " 3. three" + ] + `shouldParseTo` DocOrderedList [ + DocParagraph "one" + , DocParagraph "two" + , DocParagraph "three" + ] + + it "ignores empty lines between list items" $ do + unlines [ + "1. one" + , "" + , "2. two" + ] + `shouldParseTo` DocOrderedList [ + DocParagraph "one" + , DocParagraph "two" + ] + + it "accepts an empty list item" $ do + "1." `shouldParseTo` DocOrderedList [DocParagraph DocEmpty] + + it "accepts multi-line list items" $ do + unlines [ + "1. point one" + , " more one" + , "1. point two" + , "more two" + ] + `shouldParseTo` DocOrderedList [ + DocParagraph "point one\n more one" + , DocParagraph "point two\nmore two" + ] + + it "accepts markup in list items" $ do + "1. /foo/" `shouldParseTo` DocOrderedList [DocParagraph (DocEmphasis "foo")] + + it "requires empty lines between list and other paragraphs" $ do + unlines [ + "foo" + , "" + , "1. bar" + , "" + , "baz" + ] + `shouldParseTo` DocParagraph "foo" <> DocOrderedList [DocParagraph "bar"] <> DocParagraph "baz" + + context "when parsing definition lists" $ do + it "parses a simple list" $ do + unlines [ + " [foo] one" + , " [bar] two" + , " [baz] three" + ] + `shouldParseTo` DocDefList [ + ("foo", "one") + , ("bar", "two") + , ("baz", "three") + ] + + it "ignores empty lines between list items" $ do + unlines [ + "[foo] one" + , "" + , "[bar] two" + ] + `shouldParseTo` DocDefList [ + ("foo", "one") + , ("bar", "two") + ] + + it "accepts an empty list item" $ do + "[foo]" `shouldParseTo` DocDefList [("foo", DocEmpty)] + + it "accepts multi-line list items" $ do + unlines [ + "[foo] point one" + , " more one" + , "[bar] point two" + , "more two" + ] + `shouldParseTo` DocDefList [ + ("foo", "point one\n more one") + , ("bar", "point two\nmore two") + ] + + it "accepts markup in list items" $ do + "[foo] /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo")] + + it "accepts markup for the label" $ do + "[/foo/] bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar")] + + it "requires empty lines between list and other paragraphs" $ do + unlines [ + "foo" + , "" + , "[foo] bar" + , "" + , "baz" + ] + `shouldParseTo` DocParagraph "foo" <> DocDefList [("foo", "bar")] <> DocParagraph "baz" + + context "when parsing consecutive paragraphs" $ do + it "will not capture irrelevant consecutive lists" $ do + unlines [ " * bullet" + , "" + , "" + , " - different bullet" + , "" + , "" + , " (1) ordered" + , " " + , " 2. different bullet" + , " " + , " [cat] kitten" + , " " + , " [pineapple] fruit" + ] `shouldParseTo` + DocUnorderedList [ DocParagraph "bullet" + , DocParagraph "different bullet"] + <> DocOrderedList [ DocParagraph "ordered" + , DocParagraph "different bullet" + ] + <> DocDefList [ ("cat", "kitten") + , ("pineapple", "fruit") + ] + + context "when parsing function documentation headers" $ do + it "can parse a simple header" $ do + "= Header 1\nHello." `shouldParseTo` + DocParagraph (DocHeader (Header 1 "Header 1")) + <> DocParagraph "Hello." + + it "allow consecutive headers" $ do + "= Header 1\n== Header 2" `shouldParseTo` + DocParagraph (DocHeader (Header 1 "Header 1")) + <> DocParagraph (DocHeader (Header 2 "Header 2")) + + it "accepts markup in the header" $ do + "= /Header/ __1__\nFoo" `shouldParseTo` + DocParagraph (DocHeader + (Header 1 (DocEmphasis "Header" <> " " <> DocBold "1"))) + <> DocParagraph "Foo" diff --git a/haddock-library/test/Documentation/Haddock/Utf8Spec.hs b/haddock-library/test/Documentation/Haddock/Utf8Spec.hs new file mode 100644 index 00000000..47e12704 --- /dev/null +++ b/haddock-library/test/Documentation/Haddock/Utf8Spec.hs @@ -0,0 +1,14 @@ +module Documentation.Haddock.Utf8Spec (main, spec) where + +import Test.Hspec +import Test.QuickCheck +import Documentation.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 |