aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/test
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-library/test')
-rw-r--r--haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs9
-rw-r--r--haddock-library/test/Documentation/Haddock/ParserSpec.hs194
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
+ "![label](url)" `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
+ "![灼眼のシャナ](url)" `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"]