{-# LANGUAGE OverloadedStrings, StandaloneDeriving
, FlexibleInstances, UndecidableInstances
, IncoherentInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Haddock.ParserSpec (main, spec) where
import Control.Applicative
import Data.Maybe (isJust)
import Data.Monoid
import Data.String
import Haddock.Doc (combineStringNodes)
import qualified Haddock.Parser as Parse
import Haddock.Types
import Outputable (Outputable, showSDoc, ppr)
import RdrName (RdrName)
import Test.Hspec
import Test.QuickCheck (property)
import Helper
instance Outputable a => Show a where
show = showSDoc dynFlags . ppr
deriving instance Show a => Show (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 = Parse.parseParas dynFlags
parseString :: String -> Maybe (Doc RdrName)
parseString = Parse.parseString dynFlags
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String))
describe "parseString" $ do
let infix 1 `shouldParseTo`
shouldParseTo :: String -> Doc RdrName -> Expectation
shouldParseTo input ast = parseString input `shouldBe` Just ast
it "is total" $ do
property $ \xs ->
-- filter out primes as we might end up with an identifier
-- which will fail due to undefined DynFlags
parseString (filter (/= '\'') xs) `shouldSatisfy` isJust
context "when parsing URLs" $ do
it "parses a URL" $ do
"" `shouldParseTo`
hyperlink "http://example.com/" Nothing <> "\n"
it "accepts an optional label" $ do
"" `shouldParseTo`
hyperlink "http://example.com/" "some link" <> "\n"
it "finishes URL parsing as soon as it sees >, even if it's escaped" $ do
"le.com" `shouldParseTo`
hyperlink "http://examp\\" Nothing <> "le.com\n"
"mp\\>le.com>" `shouldParseTo`
hyperlink "http://exa\\" Nothing <> "mp>le.com>\n"
-- Likewise in label
"oo>" `shouldParseTo`
hyperlink "http://example.com" "f\\" <> "oo>\n"
it "parses inline URLs" $ do
"Not yet working, see \n , isEmptyChan" `shouldParseTo`
"Not yet working, see "
<> hyperlink "http://trac.haskell.org/haddock/ticket/223" Nothing
<> "\n , isEmptyChan\n"
context "when autolinking URLs" $ do
it "autolinks HTTP URLs" $ do
"http://example.com/" `shouldParseTo`
hyperlink "http://example.com/" Nothing <> "\n"
it "autolinks HTTPS URLs" $ do
"https://www.example.com/" `shouldParseTo`
hyperlink "https://www.example.com/" Nothing <> "\n"
it "autolinks FTP URLs" $ do
"ftp://example.com/" `shouldParseTo`
hyperlink "ftp://example.com/" Nothing <> "\n"
it "does not include a trailing exclamation mark" $ do
"http://example.com/! Some other sentence." `shouldParseTo`
hyperlink "http://example.com/" Nothing <> "! Some other sentence.\n"
it "does not include a trailing comma" $ do
"http://example.com/, Some other sentence." `shouldParseTo`
hyperlink "http://example.com/" Nothing <> ", Some other sentence.\n"
it "does not include a trailing dot" $ do
"http://example.com/. Some other sentence." `shouldParseTo`
hyperlink "http://example.com/" Nothing <> ". Some other sentence.\n"
it "does not include a trailing question mark" $ do
"http://example.com/? Some other sentence." `shouldParseTo`
hyperlink "http://example.com/" Nothing <> "? Some other sentence.\n"
describe "parseParas" $ do
let infix 1 `shouldParseTo`
shouldParseTo :: String -> Doc RdrName -> Expectation
shouldParseTo input ast = (combineStringNodes <$> parseParas input)
`shouldBe` Just ast
it "is total" $ do
property $ \xs ->
-- filter out primes as we might end up with an identifier
-- which will fail due to undefined DynFlags
parseParas (filter (/= '\'') xs) `shouldSatisfy` isJust
it "parses a paragraph" $ do
"foobar" `shouldParseTo` DocParagraph "foobar\n"
it "empty input produces DocEmpty" $ do
"" `shouldParseTo` DocEmpty
it "should preserve all regular characters" $ do
property $ \xs ->
let input = filterSpecial xs
in case input of
[] -> input `shouldParseTo` DocEmpty
_ -> input `shouldParseTo` DocParagraph (DocString $ input ++ "\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 not do /multi-line\\n emphasis/" $ 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\" <