aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2013-07-09 14:06:32 +0100
committerSimon Hengel <sol@typeful.net>2013-08-25 09:24:13 +0200
commitc298f6041c1dabff3d049b9fe7610b71fb3ff396 (patch)
tree67b603ac34a13e5e96ff4e86c539c1b065ec8116
parent90ad0ea538d2fafed2047de8414c55627b94e879 (diff)
Add spec tests.
This adds tests for all elements we can create during regular parsing. This also adds tests for text with unicode in it.
-rw-r--r--src/Haddock/Doc.hs27
-rw-r--r--test/Haddock/ParseSpec.hs381
2 files changed, 383 insertions, 25 deletions
diff --git a/src/Haddock/Doc.hs b/src/Haddock/Doc.hs
index ca3b6658..18555cfb 100644
--- a/src/Haddock/Doc.hs
+++ b/src/Haddock/Doc.hs
@@ -1,12 +1,13 @@
module Haddock.Doc (
docAppend,
- docParagraph
+ docParagraph,
+ combineStringNodes
) where
import Haddock.Types
import Data.Char (isSpace)
-
+import Control.Arrow ((***))
-- used to make parsing easier; we group the list items later
docAppend :: Doc id -> Doc id -> Doc id
@@ -63,3 +64,25 @@ docCodeBlock (DocString s)
docCodeBlock (DocAppend l r)
= DocAppend l (docCodeBlock r)
docCodeBlock d = d
+
+-- | This is a hack that joins neighbouring 'DocString's into a single one.
+-- This is done to ease up the testing and doesn't change the final result
+-- as this would be done later anyway.
+combineStringNodes :: Doc id -> Doc id
+combineStringNodes (DocAppend (DocString x) (DocString y)) = DocString (x ++ y)
+combineStringNodes (DocAppend (DocString x) (DocAppend (DocString y) z)) =
+ tryjoin (DocAppend (DocString (x ++ y)) (combineStringNodes z))
+combineStringNodes (DocAppend x y) = tryjoin (DocAppend (combineStringNodes x) (combineStringNodes y))
+combineStringNodes (DocParagraph x) = DocParagraph (combineStringNodes x)
+combineStringNodes (DocWarning x) = DocWarning (combineStringNodes x)
+combineStringNodes (DocEmphasis x) = DocEmphasis (combineStringNodes x)
+combineStringNodes (DocMonospaced x) = DocMonospaced (combineStringNodes x)
+combineStringNodes (DocUnorderedList xs) = DocUnorderedList (map combineStringNodes xs)
+combineStringNodes (DocOrderedList x) = DocOrderedList (map combineStringNodes x)
+combineStringNodes (DocDefList xs) = DocDefList (map (combineStringNodes *** combineStringNodes) xs)
+combineStringNodes (DocCodeBlock x) = DocCodeBlock (combineStringNodes x)
+combineStringNodes x = x
+
+tryjoin :: Doc id -> Doc id
+tryjoin (DocAppend (DocString x) (DocString y)) = DocString (x ++ y)
+tryjoin x = x
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