diff options
Diffstat (limited to 'haddock-library/test/Documentation')
| -rw-r--r-- | haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs | 9 | ||||
| -rw-r--r-- | haddock-library/test/Documentation/Haddock/ParserSpec.hs | 194 |
2 files changed, 163 insertions, 40 deletions
diff --git a/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs b/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs index a6ac49ee..10c701c7 100644 --- a/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs +++ b/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs @@ -1,10 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module Documentation.Haddock.Parser.UtilSpec (main, spec) where -import Data.Attoparsec.ByteString.Char8 +import Documentation.Haddock.Parser.Monad import Documentation.Haddock.Parser.Util import Data.Either.Compat (isLeft) import Test.Hspec +import Control.Applicative main :: IO () main = hspec spec @@ -13,10 +14,10 @@ spec :: Spec spec = do describe "takeUntil" $ do it "takes everything until a specified byte sequence" $ do - parseOnly (takeUntil "end") "someend" `shouldBe` Right "some" + snd <$> parseOnly (takeUntil "end") "someend" `shouldBe` Right "some" it "requires the end sequence" $ do - parseOnly (takeUntil "end") "someen" `shouldSatisfy` isLeft + snd <$> parseOnly (takeUntil "end") "someen" `shouldSatisfy` isLeft it "takes escaped bytes unconditionally" $ do - parseOnly (takeUntil "end") "some\\endend" `shouldBe` Right "some\\end" + snd <$> 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 index 5181a3f3..44ec2988 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -1,16 +1,19 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances #-} -{-# LANGUAGE IncoherentInstances, UndecidableInstances #-} {-# 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 Documentation.Haddock.Doc (docAppend) import Test.Hspec import Test.QuickCheck +infixr 6 <> +(<>) :: Doc id -> Doc id -> Doc id +(<>) = docAppend + type Doc id = DocH () id instance IsString (Doc String) where @@ -19,12 +22,15 @@ instance IsString (Doc String) where instance IsString a => IsString (Maybe a) where fromString = Just . fromString -parseParas :: String -> Doc String -parseParas = Parse.toRegular . Parse.parseParas +parseParas :: String -> MetaDoc () String +parseParas = overDoc Parse.toRegular . Parse.parseParas parseString :: String -> Doc String parseString = Parse.toRegular . Parse.parseString +hyperlink :: String -> Maybe String -> Doc String +hyperlink url = DocHyperlink . Hyperlink url + main :: IO () main = hspec spec @@ -79,10 +85,13 @@ spec = 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 "doesn't parse empty identifiers" $ do + "``" `shouldParseTo` "``" + it "can parse infix identifiers" $ do + "``infix``" `shouldParseTo` "`" <> DocIdentifier "infix" <> "`" + + context "when parsing URLs" $ do it "parses a URL" $ do "<http://example.com/>" `shouldParseTo` hyperlink "http://example.com/" Nothing @@ -111,6 +120,45 @@ spec = do it "doesn't allow for multi-line link tags" $ do "<ba\nz aar>" `shouldParseTo` "<ba\nz aar>" + context "when parsing markdown links" $ do + it "parses a simple link" $ do + "[some label](url)" `shouldParseTo` + hyperlink "url" "some label" + + it "allows whitespace between label and URL" $ do + "[some label] \t (url)" `shouldParseTo` + hyperlink "url" "some label" + + it "allows newlines in label" $ do + "[some\n\nlabel](url)" `shouldParseTo` + hyperlink "url" "some\n\nlabel" + + it "allows escaping in label" $ do + "[some\\] label](url)" `shouldParseTo` + hyperlink "url" "some] label" + + it "strips leading and trailing whitespace from label" $ do + "[ some label ](url)" `shouldParseTo` + hyperlink "url" "some label" + + it "rejects whitespace in URL" $ do + "[some label]( url)" `shouldParseTo` + "[some label]( url)" + + context "when URL is on a separate line" $ do + it "allows URL to be on a separate line" $ do + "[some label]\n(url)" `shouldParseTo` + hyperlink "url" "some label" + + it "allows leading whitespace" $ do + "[some label]\n \t (url)" `shouldParseTo` + hyperlink "url" "some label" + + it "rejects additional newlines" $ do + "[some label]\n\n(url)" `shouldParseTo` + "[some label]\n\n(url)" + + context "when autolinking URLs" $ do it "autolinks HTTP URLs" $ do "http://example.com/" `shouldParseTo` hyperlink "http://example.com/" Nothing @@ -141,24 +189,22 @@ spec = do "foo https://example.com/example bar" `shouldParseTo` "foo " <> hyperlink "https://example.com/example" Nothing <> " bar" - context "when parsing pictures" $ do - let picture :: String -> Maybe String -> Doc String - picture uri = DocPic . Picture uri + context "when parsing images" $ do + let image :: String -> Maybe String -> Doc String + image uri = DocPic . Picture uri - it "parses a simple picture" $ do - "<<baz>>" `shouldParseTo` picture "baz" Nothing + it "accepts markdown syntax for images" $ do + "" `shouldParseTo` image "url" "label" - it "parses a picture with a title" $ do - "<<b a z>>" `shouldParseTo` picture "b" (Just "a z") + it "accepts Unicode" $ do + "" `shouldParseTo` image "url" "灼眼のシャナ" - it "parses a picture with unicode" $ do - "<<灼眼のシャナ>>" `shouldParseTo` picture "灼眼のシャナ" Nothing + it "supports deprecated picture syntax" $ do + "<<baz>>" `shouldParseTo` image "baz" Nothing - it "allows for escaping of the closing tags" $ do - "<<ba\\>>z>>" `shouldParseTo` picture "ba>>z" Nothing + it "supports title for deprecated picture syntax" $ do + "<<b a z>>" `shouldParseTo` image "b" "a z" - 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 @@ -312,12 +358,39 @@ spec = do describe "parseParas" $ do let infix 1 `shouldParseTo` shouldParseTo :: String -> Doc String -> Expectation - shouldParseTo input ast = parseParas input `shouldBe` ast + shouldParseTo input ast = _doc (parseParas input) `shouldBe` ast it "is total" $ do property $ \xs -> (length . show . parseParas) xs `shouldSatisfy` (> 0) + context "when parsing @since" $ do + it "adds specified version to the result" $ do + parseParas "@since 0.5.0" `shouldBe` + MetaDoc { _meta = Meta { _version = Just [0,5,0] } + , _doc = DocEmpty } + + it "ignores trailing whitespace" $ do + parseParas "@since 0.5.0 \t " `shouldBe` + MetaDoc { _meta = Meta { _version = Just [0,5,0] } + , _doc = DocEmpty } + + it "does not allow trailing input" $ do + parseParas "@since 0.5.0 foo" `shouldBe` + MetaDoc { _meta = Meta { _version = Nothing } + , _doc = DocParagraph "@since 0.5.0 foo" } + + + context "when given multiple times" $ do + it "gives last occurrence precedence" $ do + (parseParas . unlines) [ + "@since 0.5.0" + , "@since 0.6.0" + , "@since 0.7.0" + ] `shouldBe` MetaDoc { _meta = Meta { _version = Just [0,7,0] } + , _doc = DocEmpty } + + context "when parsing text paragraphs" $ do let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String)) @@ -345,6 +418,28 @@ spec = do it "turns it into a code block" $ do "@foo@" `shouldParseTo` DocCodeBlock "foo" + context "when a paragraph starts with a markdown link" $ do + it "correctly parses it as a text paragraph (not a definition list)" $ do + "[label](url)" `shouldParseTo` + DocParagraph (hyperlink "url" "label") + + it "can be followed by an other paragraph" $ do + "[label](url)\n\nfoobar" `shouldParseTo` + DocParagraph (hyperlink "url" "label") <> DocParagraph "foobar" + + context "when paragraph contains additional text" $ do + it "accepts more text after the link" $ do + "[label](url) foo bar baz" `shouldParseTo` + DocParagraph (hyperlink "url" "label" <> " foo bar baz") + + it "accepts a newline right after the markdown link" $ do + "[label](url)\nfoo bar baz" `shouldParseTo` + DocParagraph (hyperlink "url" "label" <> " foo bar baz") + + it "can be followed by an other paragraph" $ do + "[label](url)foo\n\nbar" `shouldParseTo` + DocParagraph (hyperlink "url" "label" <> "foo") <> DocParagraph "bar" + context "when parsing birdtracks" $ do it "parses them as a code block" $ do unlines [ @@ -584,7 +679,7 @@ spec = do it "can nest definition lists" $ do - "[a] foo\n\n [b] bar\n\n [c] baz\n qux" `shouldParseTo` + "[a]: foo\n\n [b]: bar\n\n [c]: baz\n qux" `shouldParseTo` DocDefList [ ("a", "foo" <> DocDefList [ ("b", "bar" <> DocDefList [("c", "baz\nqux")]) @@ -599,12 +694,27 @@ spec = do <> 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` + "[foo]: foov\n\n [bar]: barv\n\n1. baz" `shouldParseTo` DocDefList [ ("foo", "foov" <> DocDefList [ ("bar", "barv") ]) ] <> DocOrderedList [ DocParagraph "baz" ] + it "list order is preserved in presence of nesting + extra text" $ do + "1. Foo\n\n > Some code\n\n2. Bar\n\nSome text" + `shouldParseTo` + DocOrderedList [ DocParagraph "Foo" <> DocCodeBlock "Some code" + , DocParagraph "Bar" + ] + <> DocParagraph (DocString "Some text") + + "1. Foo\n\n2. Bar\n\nSome text" + `shouldParseTo` + DocOrderedList [ DocParagraph "Foo" + , DocParagraph "Bar" + ] + <> DocParagraph (DocString "Some text") + context "when parsing properties" $ do it "can parse a single property" $ do "prop> 23 == 23" `shouldParseTo` DocProperty "23 == 23" @@ -732,9 +842,9 @@ spec = do context "when parsing definition lists" $ do it "parses a simple list" $ do unlines [ - " [foo] one" - , " [bar] two" - , " [baz] three" + " [foo]: one" + , " [bar]: two" + , " [baz]: three" ] `shouldParseTo` DocDefList [ ("foo", "one") @@ -744,9 +854,9 @@ spec = do it "ignores empty lines between list items" $ do unlines [ - "[foo] one" + "[foo]: one" , "" - , "[bar] two" + , "[bar]: two" ] `shouldParseTo` DocDefList [ ("foo", "one") @@ -754,13 +864,13 @@ spec = do ] it "accepts an empty list item" $ do - "[foo]" `shouldParseTo` DocDefList [("foo", DocEmpty)] + "[foo]:" `shouldParseTo` DocDefList [("foo", DocEmpty)] it "accepts multi-line list items" $ do unlines [ - "[foo] point one" + "[foo]: point one" , " more one" - , "[bar] point two" + , "[bar]: point two" , "more two" ] `shouldParseTo` DocDefList [ @@ -769,21 +879,33 @@ spec = do ] it "accepts markup in list items" $ do - "[foo] /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo")] + "[foo]: /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo")] it "accepts markup for the label" $ do - "[/foo/] bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar")] + "[/foo/]: bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar")] it "requires empty lines between list and other paragraphs" $ do unlines [ "foo" , "" - , "[foo] bar" + , "[foo]: bar" , "" , "baz" ] `shouldParseTo` DocParagraph "foo" <> DocDefList [("foo", "bar")] <> DocParagraph "baz" + it "dose not require the colon (deprecated - this will be removed in a future release)" $ do + unlines [ + " [foo] one" + , " [bar] two" + , " [baz] three" + ] + `shouldParseTo` DocDefList [ + ("foo", "one") + , ("bar", "two") + , ("baz", "three") + ] + context "when parsing consecutive paragraphs" $ do it "will not capture irrelevant consecutive lists" $ do unlines [ " * bullet" @@ -796,9 +918,9 @@ spec = do , " " , " 2. different bullet" , " " - , " [cat] kitten" + , " [cat]: kitten" , " " - , " [pineapple] fruit" + , " [pineapple]: fruit" ] `shouldParseTo` DocUnorderedList [ DocParagraph "bullet" , DocParagraph "different bullet"] |