1{-# LANGUAGE OverloadedStrings, FlexibleInstances #-} 2{-# OPTIONS_GHC -fno-warn-orphans #-} 3 4module Documentation.Haddock.ParserSpec (main, spec) where 5 6import Data.String 7import qualified Documentation.Haddock.Parser as Parse 8import Documentation.Haddock.Types 9import Documentation.Haddock.Doc (docAppend) 10import Test.Hspec 11import Test.QuickCheck 12 13import Prelude hiding ((<>)) 14 15infixr 6 <> 16(<>) :: Doc id -> Doc id -> Doc id 17(<>) = docAppend 18 19type Doc id = DocH () id 20 21instance IsString (Doc String) where 22 fromString = DocString 23 24instance IsString a => IsString (Maybe a) where 25 fromString = Just . fromString 26 27emptyMeta :: Meta 28emptyMeta = 29 Meta { 30 _version = Nothing 31 , _package = Nothing 32 } 33 34parseParas :: String -> MetaDoc () String 35parseParas = overDoc Parse.toRegular . Parse.parseParas Nothing 36 37parseString :: String -> Doc String 38parseString = Parse.toRegular . Parse.parseString 39 40hyperlink :: String -> Maybe (Doc String) -> Doc String 41hyperlink url = DocHyperlink . Hyperlink url 42 43main :: IO () 44main = hspec spec 45 46spec :: Spec 47spec = do 48 describe "parseString" $ do 49 let infix 1 `shouldParseTo` 50 shouldParseTo :: String -> Doc String -> Expectation 51 shouldParseTo input ast = parseString input `shouldBe` ast 52 53 it "is total" $ do 54 property $ \xs -> 55 (length . show . parseString) xs `shouldSatisfy` (> 0) 56 57 context "when parsing text" $ do 58 it "can handle unicode" $ do 59 "灼眼のシャナ" `shouldParseTo` "灼眼のシャナ" 60 61 it "accepts numeric character references" $ do 62 "foo bar baz λ" `shouldParseTo` "foo bar baz λ" 63 64 it "accepts hexadecimal character references" $ do 65 "e" `shouldParseTo` "e" 66 67 it "allows to backslash-escape characters except \\r" $ do 68 property $ \y -> case y of 69 '\r' -> "\\\r" `shouldParseTo` DocString "\\" 70 x -> ['\\', x] `shouldParseTo` DocString [x] 71 72 context "when parsing strings contaning numeric character references" $ do 73 it "will implicitly convert digits to characters" $ do 74 "AAAA" `shouldParseTo` "AAAA" 75 76 "灼眼のシャナ" 77 `shouldParseTo` "灼眼のシャナ" 78 79 it "will implicitly convert hex encoded characters" $ do 80 "eeee" `shouldParseTo` "eeee" 81 82 context "when parsing identifiers" $ do 83 it "parses identifiers enclosed within single ticks" $ do 84 "'foo'" `shouldParseTo` DocIdentifier "foo" 85 86 it "parses identifiers enclosed within backticks" $ do 87 "`foo`" `shouldParseTo` DocIdentifier "foo" 88 89 it "parses identifiers preceded by a backtick and followed by a single quote" $ do 90 "`foo'" `shouldParseTo` DocIdentifier "foo" 91 92 it "parses identifiers preceded by a single quote and followed by a backtick" $ do 93 "'foo`" `shouldParseTo` DocIdentifier "foo" 94 95 it "can parse a constructor identifier" $ do 96 "'Foo'" `shouldParseTo` DocIdentifier "Foo" 97 98 it "can parse a qualified identifier" $ do 99 "'Foo.bar'" `shouldParseTo` DocIdentifier "Foo.bar" 100 101 it "parses a word with an one of the delimiters in it as DocString" $ do 102 "don't" `shouldParseTo` "don't" 103 104 it "doesn't pass pairs of delimiters with spaces between them" $ do 105 "hel'lo w'orld" `shouldParseTo` "hel'lo w'orld" 106 107 it "don't use apostrophe's in the wrong place's" $ do 108 " don't use apostrophe's in the wrong place's" `shouldParseTo` 109 "don't use apostrophe's in the wrong place's" 110 111 it "doesn't parse empty identifiers" $ do 112 "``" `shouldParseTo` "``" 113 114 it "can parse an identifier in infix notation enclosed within backticks" $ do 115 "``infix``" `shouldParseTo` DocIdentifier "`infix`" 116 117 it "can parse identifiers containing a single quote" $ do 118 "'don't'" `shouldParseTo` DocIdentifier "don't" 119 120 it "can parse identifiers ending with a single quote" $ do 121 "'foo''" `shouldParseTo` DocIdentifier "foo'" 122 123 it "can parse an identifier containing a digit" $ do 124 "'f0'" `shouldParseTo` DocIdentifier "f0" 125 126 it "can parse an identifier containing unicode characters" $ do 127 "'λ'" `shouldParseTo` DocIdentifier "λ" 128 129 it "can parse a single quote followed by an identifier" $ do 130 "''foo'" `shouldParseTo` "'" <> DocIdentifier "foo" 131 132 it "can parse an identifier that starts with an underscore" $ do 133 "'_x'" `shouldParseTo` DocIdentifier "_x" 134 135 it "can parse value-namespaced identifiers" $ do 136 "v'foo'" `shouldParseTo` DocIdentifier "foo" 137 138 it "can parse type-namespaced identifiers" $ do 139 "t'foo'" `shouldParseTo` DocIdentifier "foo" 140 141 it "can parse parenthesized operators and backticked identifiers" $ do 142 "'(<|>)'" `shouldParseTo` DocIdentifier "(<|>)" 143 "'`elem`'" `shouldParseTo` DocIdentifier "`elem`" 144 145 it "can properly figure out the end of identifiers" $ do 146 "'DbModule'/'DbUnitId'" `shouldParseTo` DocIdentifier "DbModule" <> "/" <> DocIdentifier "DbUnitId" 147 148 context "when parsing operators" $ do 149 it "can parse an operator enclosed within single quotes" $ do 150 "'.='" `shouldParseTo` DocIdentifier ".=" 151 152 it "can parse a qualified operator" $ do 153 "'F..'" `shouldParseTo` DocIdentifier "F.." 154 155 it "can parse a constructor operator" $ do 156 "':='" `shouldParseTo` DocIdentifier ":=" 157 158 it "can parse a qualified constructor operator" $ do 159 "'F.:='" `shouldParseTo` DocIdentifier "F.:=" 160 161 it "can parse a unicode operator" $ do 162 "'∧'" `shouldParseTo` DocIdentifier "∧" 163 164 context "when parsing URLs" $ do 165 it "parses a URL" $ do 166 "<http://example.com/>" `shouldParseTo` hyperlink "http://example.com/" Nothing 167 168 it "accepts an optional label" $ do 169 "<http://example.com/ some link>" `shouldParseTo` hyperlink "http://example.com/" "some link" 170 171 it "does not accept newlines in label" $ do 172 "<foo bar\nbaz>" `shouldParseTo` "<foo bar\nbaz>" 173 174 -- new behaviour test, this will be now consistent with other markup 175 it "allows us to escape > inside the URL" $ do 176 "<http://examp\\>le.com>" `shouldParseTo` 177 hyperlink "http://examp>le.com" Nothing 178 179 "<http://exa\\>mp\\>le.com>" `shouldParseTo` 180 hyperlink "http://exa>mp>le.com" Nothing 181 182 -- Likewise in label 183 "<http://example.com f\\>oo>" `shouldParseTo` 184 hyperlink "http://example.com" "f>oo" 185 186 it "parses inline URLs" $ do 187 "foo <http://example.com/> bar" `shouldParseTo` 188 "foo " <> hyperlink "http://example.com/" Nothing <> " bar" 189 190 it "doesn't allow for multi-line link tags" $ do 191 "<ba\nz aar>" `shouldParseTo` "<ba\nz aar>" 192 193 context "when parsing markdown links" $ do 194 it "parses a simple link" $ do 195 "[some label](url)" `shouldParseTo` 196 hyperlink "url" "some label" 197 198 it "allows whitespace between label and URL" $ do 199 "[some label] \t (url)" `shouldParseTo` 200 hyperlink "url" "some label" 201 202 it "allows newlines in label" $ do 203 "[some\n\nlabel](url)" `shouldParseTo` 204 hyperlink "url" "some\n\nlabel" 205 206 it "allows escaping in label" $ do 207 "[some\\] label](url)" `shouldParseTo` 208 hyperlink "url" "some] label" 209 210 it "strips leading and trailing whitespace from label" $ do 211 "[ some label ](url)" `shouldParseTo` 212 hyperlink "url" "some label" 213 214 it "rejects whitespace in URL" $ do 215 "[some label]( url)" `shouldParseTo` 216 "[some label]( url)" 217 218 it "allows inline markup in the label" $ do 219 "[something /emphasized/](url)" `shouldParseTo` 220 hyperlink "url" (Just ("something " <> DocEmphasis "emphasized")) 221 222 context "when URL is on a separate line" $ do 223 it "allows URL to be on a separate line" $ do 224 "[some label]\n(url)" `shouldParseTo` 225 hyperlink "url" "some label" 226 227 it "allows leading whitespace" $ do 228 "[some label]\n \t (url)" `shouldParseTo` 229 hyperlink "url" "some label" 230 231 it "rejects additional newlines" $ do 232 "[some label]\n\n(url)" `shouldParseTo` 233 "[some label]\n\n(url)" 234 235 236 context "when autolinking URLs" $ do 237 it "autolinks HTTP URLs" $ do 238 "http://example.com/" `shouldParseTo` hyperlink "http://example.com/" Nothing 239 240 it "autolinks HTTPS URLs" $ do 241 "https://www.example.com/" `shouldParseTo` hyperlink "https://www.example.com/" Nothing 242 243 it "autolinks FTP URLs" $ do 244 "ftp://example.com/" `shouldParseTo` hyperlink "ftp://example.com/" Nothing 245 246 it "does not include a trailing comma" $ do 247 "http://example.com/, Some other sentence." `shouldParseTo` 248 hyperlink "http://example.com/" Nothing <> ", Some other sentence." 249 250 it "does not include a trailing dot" $ do 251 "http://example.com/. Some other sentence." `shouldParseTo` 252 hyperlink "http://example.com/" Nothing <> ". Some other sentence." 253 254 it "does not include a trailing exclamation mark" $ do 255 "http://example.com/! Some other sentence." `shouldParseTo` 256 hyperlink "http://example.com/" Nothing <> "! Some other sentence." 257 258 it "does not include a trailing question mark" $ do 259 "http://example.com/? Some other sentence." `shouldParseTo` 260 hyperlink "http://example.com/" Nothing <> "? Some other sentence." 261 262 it "autolinks URLs occuring mid-sentence with multiple ‘/’s" $ do 263 "foo https://example.com/example bar" `shouldParseTo` 264 "foo " <> hyperlink "https://example.com/example" Nothing <> " bar" 265 266 context "when parsing images" $ do 267 let image :: String -> Maybe String -> Doc String 268 image uri = DocPic . Picture uri 269 270 it "accepts markdown syntax for images" $ do 271 "" `shouldParseTo` image "url" "label" 272 273 it "accepts Unicode" $ do 274 "" `shouldParseTo` image "url" "灼眼のシャナ" 275 276 it "supports deprecated picture syntax" $ do 277 "<<baz>>" `shouldParseTo` image "baz" Nothing 278 279 it "supports title for deprecated picture syntax" $ do 280 "<<b a z>>" `shouldParseTo` image "b" "a z" 281 282 context "when parsing display math" $ do 283 284 it "accepts markdown syntax for display math containing newlines" $ do 285 "\\[\\pi\n\\pi\\]" `shouldParseTo` DocMathDisplay "\\pi\n\\pi" 286 287 context "when parsing anchors" $ do 288 it "parses a single word anchor" $ do 289 "#foo#" `shouldParseTo` DocAName "foo" 290 291 it "parses a multi word anchor" $ do 292 "#foo bar#" `shouldParseTo` DocAName "foo bar" 293 294 it "parses a unicode anchor" $ do 295 "#灼眼のシャナ#" `shouldParseTo` DocAName "灼眼のシャナ" 296 297 it "does not accept newlines in anchors" $ do 298 "#foo\nbar#" `shouldParseTo` "#foo\nbar#" 299 300 it "accepts anchors mid-paragraph" $ do 301 "Hello #someAnchor# world!" 302 `shouldParseTo` "Hello " <> DocAName "someAnchor" <> " world!" 303 304 it "does not accept empty anchors" $ do 305 "##" `shouldParseTo` "##" 306 307 context "when parsing emphasised text" $ do 308 it "emphasises a word on its own" $ do 309 "/foo/" `shouldParseTo` DocEmphasis "foo" 310 311 it "emphasises inline correctly" $ do 312 "foo /bar/ baz" `shouldParseTo` "foo " <> DocEmphasis "bar" <> " baz" 313 314 it "emphasises unicode" $ do 315 "/灼眼のシャナ/" `shouldParseTo` DocEmphasis "灼眼のシャナ" 316 317 it "does not emphasise multi-line strings" $ do 318 " /foo\nbar/" `shouldParseTo` "/foo\nbar/" 319 320 it "does not emphasise the empty string" $ do 321 "//" `shouldParseTo` "//" 322 323 it "parses escaped slashes literally" $ do 324 "/foo\\/bar/" `shouldParseTo` DocEmphasis "foo/bar" 325 326 it "recognizes other markup constructs within emphasised text" $ do 327 "/foo @bar@ baz/" `shouldParseTo` 328 DocEmphasis ("foo " <> DocMonospaced "bar" <> " baz") 329 330 it "allows other markup inside of emphasis" $ do 331 "/__inner bold__/" `shouldParseTo` DocEmphasis (DocBold "inner bold") 332 333 it "doesn't mangle inner markup unicode" $ do 334 "/__灼眼のシャナ A__/" `shouldParseTo` DocEmphasis (DocBold "灼眼のシャナ A") 335 336 it "properly converts HTML escape sequences" $ do 337 "/AAAA/" `shouldParseTo` DocEmphasis "AAAA" 338 339 it "allows to escape the emphasis delimiter inside of emphasis" $ do 340 "/empha\\/sis/" `shouldParseTo` DocEmphasis "empha/sis" 341 342 context "when parsing monospaced text" $ do 343 it "parses simple monospaced text" $ do 344 "@foo@" `shouldParseTo` DocMonospaced "foo" 345 346 it "parses inline monospaced text" $ do 347 "foo @bar@ baz" `shouldParseTo` "foo " <> DocMonospaced "bar" <> " baz" 348 349 it "allows to escape @" $ do 350 "@foo \\@ bar@" `shouldParseTo` DocMonospaced "foo @ bar" 351 352 it "accepts unicode" $ do 353 "@foo 灼眼のシャナ bar@" `shouldParseTo` DocMonospaced "foo 灼眼のシャナ bar" 354 355 it "accepts other markup in monospaced text" $ do 356 "@/foo/@" `shouldParseTo` DocMonospaced (DocEmphasis "foo") 357 358 it "requires the closing @" $ do 359 "@foo /bar/ baz" `shouldParseTo` "@foo " <> DocEmphasis "bar" <> " baz" 360 361 context "when parsing bold strings" $ do 362 it "allows for a bold string on its own" $ do 363 "__bold string__" `shouldParseTo` 364 DocBold "bold string" 365 366 it "bolds inline correctly" $ do 367 "hello __everyone__ there" `shouldParseTo` 368 "hello " 369 <> DocBold "everyone" <> " there" 370 371 it "bolds unicode" $ do 372 "__灼眼のシャナ__" `shouldParseTo` 373 DocBold "灼眼のシャナ" 374 375 it "does not do __multi-line\\n bold__" $ do 376 " __multi-line\n bold__" `shouldParseTo` "__multi-line\n bold__" 377 378 it "allows other markup inside of bold" $ do 379 "__/inner emphasis/__" `shouldParseTo` 380 (DocBold $ DocEmphasis "inner emphasis") 381 382 it "doesn't mangle inner markup unicode" $ do 383 "__/灼眼のシャナ A/__" `shouldParseTo` 384 (DocBold $ DocEmphasis "灼眼のシャナ A") 385 386 it "properly converts HTML escape sequences" $ do 387 "__AAAA__" `shouldParseTo` 388 DocBold "AAAA" 389 390 it "allows to escape the bold delimiter inside of bold" $ do 391 "__bo\\__ld__" `shouldParseTo` 392 DocBold "bo__ld" 393 394 it "doesn't allow for empty bold" $ do 395 "____" `shouldParseTo` "____" 396 397 context "when parsing module strings" $ do 398 it "should parse a module on its own" $ do 399 "\"Module\"" `shouldParseTo` 400 DocModule "Module" 401 402 it "should parse a module inline" $ do 403 "This is a \"Module\"." `shouldParseTo` 404 "This is a " <> DocModule "Module" <> "." 405 406 it "can accept a simple module name" $ do 407 "\"Hello\"" `shouldParseTo` DocModule "Hello" 408 409 it "can accept a module name with dots" $ do 410 "\"Hello.World\"" `shouldParseTo` DocModule "Hello.World" 411 412 it "can accept a module name with unicode" $ do 413 "\"Hello.Worldλ\"" `shouldParseTo` DocModule "Hello.Worldλ" 414 415 it "parses a module name with a trailing dot as regular quoted string" $ do 416 "\"Hello.\"" `shouldParseTo` "\"Hello.\"" 417 418 it "parses a module name with a space as regular quoted string" $ do 419 "\"Hello World\"" `shouldParseTo` "\"Hello World\"" 420 421 it "parses a module name with invalid characters as regular quoted string" $ do 422 "\"Hello&[{}(=*)+]!\"" `shouldParseTo` "\"Hello&[{}(=*)+]!\"" 423 424 it "accepts a module name with unicode" $ do 425 "\"Foo.Barλ\"" `shouldParseTo` DocModule "Foo.Barλ" 426 427 it "treats empty module name as regular double quotes" $ do 428 "\"\"" `shouldParseTo` "\"\"" 429 430 it "accepts anchor reference syntax as DocModule" $ do 431 "\"Foo#bar\"" `shouldParseTo` DocModule "Foo#bar" 432 433 it "accepts old anchor reference syntax as DocModule" $ do 434 "\"Foo\\#bar\"" `shouldParseTo` DocModule "Foo\\#bar" 435 436 describe "parseParas" $ do 437 let infix 1 `shouldParseTo` 438 shouldParseTo :: String -> Doc String -> Expectation 439 shouldParseTo input ast = _doc (parseParas input) `shouldBe` ast 440 441 it "is total" $ do 442 property $ \xs -> 443 (length . show . parseParas) xs `shouldSatisfy` (> 0) 444 445 context "when parsing @since" $ do 446 it "adds specified version to the result" $ do 447 parseParas "@since 0.5.0" `shouldBe` 448 MetaDoc { _meta = emptyMeta { _version = Just [0,5,0] } 449 , _doc = DocEmpty } 450 451 it "ignores trailing whitespace" $ do 452 parseParas "@since 0.5.0 \t " `shouldBe` 453 MetaDoc { _meta = emptyMeta { _version = Just [0,5,0] } 454 , _doc = DocEmpty } 455 456 it "does not allow trailing input" $ do 457 parseParas "@since 0.5.0 foo" `shouldBe` 458 MetaDoc { _meta = emptyMeta { _version = Nothing } 459 , _doc = DocParagraph "@since 0.5.0 foo" } 460 461 462 context "when given multiple times" $ do 463 it "gives last occurrence precedence" $ do 464 (parseParas . unlines) [ 465 "@since 0.5.0" 466 , "@since 0.6.0" 467 , "@since 0.7.0" 468 ] `shouldBe` MetaDoc { _meta = emptyMeta { _version = Just [0,7,0] } 469 , _doc = DocEmpty } 470 471 472 context "when parsing text paragraphs" $ do 473 let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String)) 474 475 it "parses an empty paragraph" $ do 476 "" `shouldParseTo` DocEmpty 477 478 it "parses a simple text paragraph" $ do 479 "foo bar baz" `shouldParseTo` DocParagraph "foo bar baz" 480 481 it "accepts markup in text paragraphs" $ do 482 "foo /bar/ baz" `shouldParseTo` DocParagraph ("foo " <> DocEmphasis "bar" <> " baz") 483 484 it "preserve all regular characters" $ do 485 property $ \xs -> let input = filterSpecial xs in (not . null) input ==> 486 input `shouldParseTo` DocParagraph (DocString input) 487 488 it "separates paragraphs by empty lines" $ do 489 unlines [ 490 "foo" 491 , " \t " 492 , "bar" 493 ] `shouldParseTo` DocParagraph "foo" <> DocParagraph "bar" 494 495 context "when a pragraph only contains monospaced text" $ do 496 it "turns it into a code block" $ do 497 "@foo@" `shouldParseTo` DocCodeBlock "foo" 498 499 context "when a paragraph starts with a markdown link" $ do 500 it "correctly parses it as a text paragraph (not a definition list)" $ do 501 "[label](url)" `shouldParseTo` 502 DocParagraph (hyperlink "url" "label") 503 504 it "can be followed by an other paragraph" $ do 505 "[label](url)\n\nfoobar" `shouldParseTo` 506 DocParagraph (hyperlink "url" "label") <> DocParagraph "foobar" 507 508 context "when paragraph contains additional text" $ do 509 it "accepts more text after the link" $ do 510 "[label](url) foo bar baz" `shouldParseTo` 511 DocParagraph (hyperlink "url" "label" <> " foo bar baz") 512 513 it "accepts a newline right after the markdown link" $ do 514 "[label](url)\nfoo bar baz" `shouldParseTo` 515 DocParagraph (hyperlink "url" "label" <> " foo bar baz") 516 517 it "can be followed by an other paragraph" $ do 518 "[label](url)foo\n\nbar" `shouldParseTo` 519 DocParagraph (hyperlink "url" "label" <> "foo") <> DocParagraph "bar" 520 521 context "when parsing birdtracks" $ do 522 it "parses them as a code block" $ do 523 unlines [ 524 ">foo" 525 , ">bar" 526 , ">baz" 527 ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" 528 529 it "ignores leading whitespace" $ do 530 unlines [ 531 " >foo" 532 , " \t >bar" 533 , " >baz" 534 ] 535 `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" 536 537 it "strips one leading space from each line of the block" $ do 538 unlines [ 539 "> foo" 540 , "> bar" 541 , "> baz" 542 ] `shouldParseTo` DocCodeBlock "foo\n bar\nbaz" 543 544 it "ignores empty lines when stripping spaces" $ do 545 unlines [ 546 "> foo" 547 , ">" 548 , "> bar" 549 ] `shouldParseTo` DocCodeBlock "foo\n\nbar" 550 551 context "when any non-empty line does not start with a space" $ do 552 it "does not strip any spaces" $ do 553 unlines [ 554 ">foo" 555 , "> bar" 556 ] `shouldParseTo` DocCodeBlock "foo\n bar" 557 558 it "ignores nested markup" $ do 559 unlines [ 560 ">/foo/" 561 ] `shouldParseTo` DocCodeBlock "/foo/" 562 563 it "treats them as regular text inside text paragraphs" $ do 564 unlines [ 565 "foo" 566 , ">bar" 567 ] `shouldParseTo` DocParagraph "foo\n>bar" 568 569 context "when parsing code blocks" $ do 570 it "accepts a simple code block" $ do 571 unlines [ 572 "@" 573 , "foo" 574 , "bar" 575 , "baz" 576 , "@" 577 ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz\n" 578 579 it "ignores trailing whitespace after the opening @" $ do 580 unlines [ 581 "@ " 582 , "foo" 583 , "@" 584 ] `shouldParseTo` DocCodeBlock "foo\n" 585 586 it "rejects code blocks that are not closed" $ do 587 unlines [ 588 "@" 589 , "foo" 590 ] `shouldParseTo` DocParagraph "@\nfoo" 591 592 it "accepts nested markup" $ do 593 unlines [ 594 "@" 595 , "/foo/" 596 , "@" 597 ] `shouldParseTo` DocCodeBlock (DocEmphasis "foo" <> "\n") 598 599 it "allows to escape the @" $ do 600 unlines [ 601 "@" 602 , "foo" 603 , "\\@" 604 , "bar" 605 , "@" 606 ] `shouldParseTo` DocCodeBlock "foo\n@\nbar\n" 607 608 it "accepts horizontal space before the @" $ do 609 unlines [ " @" 610 , "foo" 611 , "" 612 , "bar" 613 , "@" 614 ] `shouldParseTo` DocCodeBlock "foo\n\nbar\n" 615 616 it "strips a leading space from a @ block if present" $ do 617 unlines [ " @" 618 , " hello" 619 , " world" 620 , " @" 621 ] `shouldParseTo` DocCodeBlock "hello\nworld\n" 622 623 unlines [ " @" 624 , " hello" 625 , "" 626 , " world" 627 , " @" 628 ] `shouldParseTo` DocCodeBlock "hello\n\nworld\n" 629 630 it "only drops whitespace if there's some before closing @" $ do 631 unlines [ "@" 632 , " Formatting" 633 , " matters." 634 , "@" 635 ] 636 `shouldParseTo` DocCodeBlock " Formatting\n matters.\n" 637 638 it "accepts unicode" $ do 639 "@foo 灼眼のシャナ bar@" `shouldParseTo` DocCodeBlock "foo 灼眼のシャナ bar" 640 641 it "requires the closing @" $ do 642 "@foo /bar/ baz" 643 `shouldParseTo` DocParagraph ("@foo " <> DocEmphasis "bar" <> " baz") 644 645 646 context "when parsing examples" $ do 647 it "parses a simple example" $ do 648 ">>> foo" `shouldParseTo` DocExamples [Example "foo" []] 649 650 it "parses an example with result" $ do 651 unlines [ 652 ">>> foo" 653 , "bar" 654 , "baz" 655 ] `shouldParseTo` DocExamples [Example "foo" ["bar", "baz"]] 656 657 it "parses consecutive examples" $ do 658 unlines [ 659 ">>> fib 5" 660 , "5" 661 , ">>> fib 10" 662 , "55" 663 ] `shouldParseTo` DocExamples [ 664 Example "fib 5" ["5"] 665 , Example "fib 10" ["55"] 666 ] 667 668 it ("requires an example to be separated" 669 ++ " from a previous paragraph by an empty line") $ do 670 "foobar\n\n>>> fib 10\n55" `shouldParseTo` 671 DocParagraph "foobar" 672 <> DocExamples [Example "fib 10" ["55"]] 673 674 it "parses bird-tracks inside of paragraphs as plain strings" $ do 675 let xs = "foo\n>>> bar" 676 xs `shouldParseTo` DocParagraph (DocString xs) 677 678 it "skips empty lines in front of an example" $ do 679 "\n \n\n>>> foo" `shouldParseTo` DocExamples [Example "foo" []] 680 681 it "terminates example on empty line" $ do 682 unlines [ 683 ">>> foo" 684 , "bar" 685 , " " 686 , "baz" 687 ] 688 `shouldParseTo` 689 DocExamples [Example "foo" ["bar"]] <> DocParagraph "baz" 690 691 it "parses a <BLANKLINE> result as an empty result" $ do 692 unlines [ 693 ">>> foo" 694 , "bar" 695 , "<BLANKLINE>" 696 , "baz" 697 ] 698 `shouldParseTo` DocExamples [Example "foo" ["bar", "", "baz"]] 699 700 it "accepts unicode in examples" $ do 701 ">>> 灼眼\nシャナ" `shouldParseTo` DocExamples [Example "灼眼" ["シャナ"]] 702 703 context "when prompt is prefixed by whitespace" $ do 704 it "strips the exact same amount of whitespace from result lines" $ do 705 unlines [ 706 " >>> foo" 707 , " bar" 708 , " baz" 709 ] `shouldParseTo` DocExamples [Example "foo" ["bar", "baz"]] 710 711 it "preserves additional whitespace" $ do 712 unlines [ 713 " >>> foo" 714 , " bar" 715 ] `shouldParseTo` DocExamples [Example "foo" [" bar"]] 716 717 it "keeps original if stripping is not possible" $ do 718 unlines [ 719 " >>> foo" 720 , " bar" 721 ] `shouldParseTo` DocExamples [Example "foo" [" bar"]] 722 723 724 context "when parsing paragraphs nested in lists" $ do 725 it "can nest the same type of list" $ do 726 "* foo\n\n * bar" `shouldParseTo` 727 DocUnorderedList [ DocParagraph "foo" 728 <> DocUnorderedList [DocParagraph "bar"]] 729 730 it "can nest another type of list inside" $ do 731 "* foo\n\n 1. bar" `shouldParseTo` 732 DocUnorderedList [ DocParagraph "foo" 733 <> DocOrderedList [DocParagraph "bar"]] 734 735 it "can nest a code block inside" $ do 736 "* foo\n\n @foo bar baz@" `shouldParseTo` 737 DocUnorderedList [ DocParagraph "foo" 738 <> DocCodeBlock "foo bar baz"] 739 740 "* foo\n\n @\n foo bar baz\n @" `shouldParseTo` 741 DocUnorderedList [ DocParagraph "foo" 742 <> DocCodeBlock "foo bar baz\n"] 743 744 it "can nest more than one level" $ do 745 "* foo\n\n * bar\n\n * baz\n qux" `shouldParseTo` 746 DocUnorderedList [ DocParagraph "foo" 747 <> DocUnorderedList [ DocParagraph "bar" 748 <> DocUnorderedList [DocParagraph "baz\nqux"] 749 ] 750 ] 751 752 it "won't fail on not fully indented paragraph" $ do 753 "* foo\n\n * bar\n\n * qux\nquux" `shouldParseTo` 754 DocUnorderedList [ DocParagraph "foo" 755 <> DocUnorderedList [ DocParagraph "bar" ] 756 , DocParagraph "qux\nquux"] 757 758 759 it "can nest definition lists" $ do 760 "[a]: foo\n\n [b]: bar\n\n [c]: baz\n qux" `shouldParseTo` 761 DocDefList [ ("a", "foo" 762 <> DocDefList [ ("b", "bar" 763 <> DocDefList [("c", "baz\nqux")]) 764 ]) 765 ] 766 767 it "can come back to top level with a different list" $ do 768 "* foo\n\n * bar\n\n1. baz" `shouldParseTo` 769 DocUnorderedList [ DocParagraph "foo" 770 <> DocUnorderedList [ DocParagraph "bar" ] 771 ] 772 <> DocOrderedList [ DocParagraph "baz" ] 773 774 it "allows arbitrary initial indent of a list" $ do 775 unlines 776 [ " * foo" 777 , " * bar" 778 , "" 779 , " * quux" 780 , "" 781 , " * baz" 782 ] 783 `shouldParseTo` 784 DocUnorderedList 785 [ DocParagraph "foo" 786 , DocParagraph "bar" 787 <> DocUnorderedList [ DocParagraph "quux" ] 788 , DocParagraph "baz" 789 ] 790 791 it "definition lists can come back to top level with a different list" $ do 792 "[foo]: foov\n\n [bar]: barv\n\n1. baz" `shouldParseTo` 793 DocDefList [ ("foo", "foov" 794 <> DocDefList [ ("bar", "barv") ]) 795 ] 796 <> DocOrderedList [ DocParagraph "baz" ] 797 798 it "list order is preserved in presence of nesting + extra text" $ do 799 "1. Foo\n\n > Some code\n\n2. Bar\n\nSome text" 800 `shouldParseTo` 801 DocOrderedList [ DocParagraph "Foo" <> DocCodeBlock "Some code" 802 , DocParagraph "Bar" 803 ] 804 <> DocParagraph (DocString "Some text") 805 806 "1. Foo\n\n2. Bar\n\nSome text" 807 `shouldParseTo` 808 DocOrderedList [ DocParagraph "Foo" 809 , DocParagraph "Bar" 810 ] 811 <> DocParagraph (DocString "Some text") 812 813 context "when parsing properties" $ do 814 it "can parse a single property" $ do 815 "prop> 23 == 23" `shouldParseTo` DocProperty "23 == 23" 816 817 it "can parse multiple subsequent properties" $ do 818 unlines [ 819 "prop> 23 == 23" 820 , "prop> 42 == 42" 821 ] 822 `shouldParseTo` 823 DocProperty "23 == 23" <> DocProperty "42 == 42" 824 825 it "accepts unicode in properties" $ do 826 "prop> 灼眼のシャナ ≡ 愛" `shouldParseTo` 827 DocProperty "灼眼のシャナ ≡ 愛" 828 829 it "can deal with whitespace before and after the prop> prompt" $ do 830 " prop> xs == (reverse $ reverse xs) " `shouldParseTo` 831 DocProperty "xs == (reverse $ reverse xs)" 832 833 context "when parsing unordered lists" $ do 834 it "parses a simple list" $ do 835 unlines [ 836 " * one" 837 , " * two" 838 , " * three" 839 ] 840 `shouldParseTo` DocUnorderedList [ 841 DocParagraph "one" 842 , DocParagraph "two" 843 , DocParagraph "three" 844 ] 845 846 it "ignores empty lines between list items" $ do 847 unlines [ 848 "* one" 849 , "" 850 , "* two" 851 ] 852 `shouldParseTo` DocUnorderedList [ 853 DocParagraph "one" 854 , DocParagraph "two" 855 ] 856 857 it "accepts an empty list item" $ do 858 "*" `shouldParseTo` DocUnorderedList [DocParagraph DocEmpty] 859 860 it "accepts multi-line list items" $ do 861 unlines [ 862 "* point one" 863 , " more one" 864 , "* point two" 865 , "more two" 866 ] 867 `shouldParseTo` DocUnorderedList [ 868 DocParagraph "point one\n more one" 869 , DocParagraph "point two\nmore two" 870 ] 871 872 it "accepts markup in list items" $ do 873 "* /foo/" `shouldParseTo` DocUnorderedList [DocParagraph (DocEmphasis "foo")] 874 875 it "requires empty lines between list and other paragraphs" $ do 876 unlines [ 877 "foo" 878 , "" 879 , "* bar" 880 , "" 881 , "baz" 882 ] 883 `shouldParseTo` DocParagraph "foo" <> DocUnorderedList [DocParagraph "bar"] <> DocParagraph "baz" 884 885 context "when parsing ordered lists" $ do 886 it "parses a simple list" $ do 887 unlines [ 888 " 1. one" 889 , " (1) two" 890 , " 3. three" 891 ] 892 `shouldParseTo` DocOrderedList [ 893 DocParagraph "one" 894 , DocParagraph "two" 895 , DocParagraph "three" 896 ] 897 898 it "ignores empty lines between list items" $ do 899 unlines [ 900 "1. one" 901 , "" 902 , "2. two" 903 ] 904 `shouldParseTo` DocOrderedList [ 905 DocParagraph "one" 906 , DocParagraph "two" 907 ] 908 909 it "accepts an empty list item" $ do 910 "1." `shouldParseTo` DocOrderedList [DocParagraph DocEmpty] 911 912 it "accepts multi-line list items" $ do 913 unlines [ 914 "1. point one" 915 , " more one" 916 , "1. point two" 917 , "more two" 918 ] 919 `shouldParseTo` DocOrderedList [ 920 DocParagraph "point one\n more one" 921 , DocParagraph "point two\nmore two" 922 ] 923 924 it "accepts markup in list items" $ do 925 "1. /foo/" `shouldParseTo` DocOrderedList [DocParagraph (DocEmphasis "foo")] 926 927 it "requires empty lines between list and other paragraphs" $ do 928 unlines [ 929 "foo" 930 , "" 931 , "1. bar" 932 , "" 933 , "baz" 934 ] 935 `shouldParseTo` DocParagraph "foo" <> DocOrderedList [DocParagraph "bar"] <> DocParagraph "baz" 936 937 context "when parsing definition lists" $ do 938 it "parses a simple list" $ do 939 unlines [ 940 " [foo]: one" 941 , " [bar]: two" 942 , " [baz]: three" 943 ] 944 `shouldParseTo` DocDefList [ 945 ("foo", "one") 946 , ("bar", "two") 947 , ("baz", "three") 948 ] 949 950 it "ignores empty lines between list items" $ do 951 unlines [ 952 "[foo]: one" 953 , "" 954 , "[bar]: two" 955 ] 956 `shouldParseTo` DocDefList [ 957 ("foo", "one") 958 , ("bar", "two") 959 ] 960 961 it "accepts an empty list item" $ do 962 "[foo]:" `shouldParseTo` DocDefList [("foo", DocEmpty)] 963 964 it "accepts multi-line list items" $ do 965 unlines [ 966 "[foo]: point one" 967 , " more one" 968 , "[bar]: point two" 969 , "more two" 970 ] 971 `shouldParseTo` DocDefList [ 972 ("foo", "point one\n more one") 973 , ("bar", "point two\nmore two") 974 ] 975 976 it "accepts markup in list items" $ do 977 "[foo]: /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo")] 978 979 it "accepts markup for the label" $ do 980 "[/foo/]: bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar")] 981 982 it "requires empty lines between list and other paragraphs" $ do 983 unlines [ 984 "foo" 985 , "" 986 , "[foo]: bar" 987 , "" 988 , "baz" 989 ] 990 `shouldParseTo` DocParagraph "foo" <> DocDefList [("foo", "bar")] <> DocParagraph "baz" 991 992 it "dose not require the colon (deprecated - this will be removed in a future release)" $ do 993 unlines [ 994 " [foo] one" 995 , " [bar] two" 996 , " [baz] three" 997 ] 998 `shouldParseTo` DocDefList [ 999 ("foo", "one") 1000 , ("bar", "two") 1001 , ("baz", "three") 1002 ] 1003 1004 context "when parsing consecutive paragraphs" $ do 1005 it "will not capture irrelevant consecutive lists" $ do 1006 unlines [ " * bullet" 1007 , "" 1008 , "" 1009 , " - different bullet" 1010 , "" 1011 , "" 1012 , " (1) ordered" 1013 , " " 1014 , " 2. different bullet" 1015 , " " 1016 , " [cat]: kitten" 1017 , " " 1018 , " [pineapple]: fruit" 1019 ] `shouldParseTo` 1020 DocUnorderedList [ DocParagraph "bullet" 1021 , DocParagraph "different bullet"] 1022 <> DocOrderedList [ DocParagraph "ordered" 1023 , DocParagraph "different bullet" 1024 ] 1025 <> DocDefList [ ("cat", "kitten") 1026 , ("pineapple", "fruit") 1027 ] 1028 1029 context "when parsing function documentation headers" $ do 1030 it "can parse a simple header" $ do 1031 "= Header 1\nHello." `shouldParseTo` 1032 (DocHeader (Header 1 "Header 1")) 1033 <> DocParagraph "Hello." 1034 1035 it "allow consecutive headers" $ do 1036 "= Header 1\n== Header 2" `shouldParseTo` 1037 DocHeader (Header 1 "Header 1") 1038 <> DocHeader (Header 2 "Header 2") 1039 1040 it "accepts markup in the header" $ do 1041 "= /Header/ __1__\nFoo" `shouldParseTo` 1042 DocHeader (Header 1 (DocEmphasis "Header" <> " " <> DocBold "1")) 1043 <> DocParagraph "Foo" 1044