git.iko.soy/typeable/html-parse
on 02fd95a help sign in
typeable/html-parse/tests/Text/HTML/ParserSpec.hs
76 lines 2.4 kB history raw
1{-# LANGUAGE GADTs #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ViewPatterns #-}
7{-# OPTIONS_GHC -Wall -Werror -fno-warn-orphans #-}
9module Text.HTML.ParserSpec
10where
12import Control.Applicative
13import Data.Monoid
14import qualified Data.Text as T
15import qualified Data.Text.Lazy as TL
16import qualified Data.Text.Lazy.Builder as B
17import Test.Hspec
18import Test.QuickCheck
19import Test.QuickCheck.Instances ()
20import Text.HTML.Parser
23instance Arbitrary Token where
24 arbitrary = oneof [validOpen, validClose, validFlat]
26 shrink (TagOpen n as) = TagOpen n <$> shrink as
27 shrink (TagClose _) = []
28 shrink (ContentText _) = []
29 shrink (ContentChar _) = []
30 shrink (Comment b) = Comment . B.fromText <$> (shrink . TL.toStrict . B.toLazyText $ b)
31 shrink (Doctype t) = Doctype <$> shrink t
33instance Arbitrary Attr where
34 arbitrary = Attr <$> validXmlTag <*> validXmlText
35 shrink (Attr k v) = Attr <$> shrink k <*> shrink v
37validOpen :: Gen Token
38validOpen = TagOpen <$> validXmlTag <*> arbitrary
40validClose :: Gen Token
41validClose = TagClose <$> validXmlTag
43validFlat :: Gen Token
44validFlat = oneof
45 [ ContentChar <$> validXmlChar
46 , ContentText <$> validXmlText
47 , Comment . B.fromText <$> validXmlText
48 , Doctype <$> validXmlText
49 ]
51validXmlChar :: Gen Char
52validXmlChar = elements (' ' : ['a'..'z']) -- FIXME: generate wider range of values
54validXmlTag :: Gen T.Text
55validXmlTag = T.pack <$> sized (`maxListOf1` elements ['a'..'z']) -- FIXME: generate wider range of values
57validXmlText :: Gen T.Text
58validXmlText = mconcat <$> sized (`maxListOf` (T.cons <$> validXmlChar <*> validXmlTag)) -- FIXME: generate wider range of values
60maxListOf :: Int -> Gen a -> Gen [a]
61maxListOf n g = take n <$> listOf g
63maxListOf1 :: Int -> Gen a -> Gen [a]
64maxListOf1 (min 1 -> n) g = take n <$> listOf1 g
68spec :: Spec
69spec = do
70 it "parseTokens and renderTokens are inverse" . property . forAllShrink arbitrary shrink $
71 \(canonicalizeTokens -> tokens)
72 -> (parseTokens . TL.toStrict . renderTokens $ tokens) `shouldBe` tokens
74 it "canonicalizeTokens is idempotent" . property . forAllShrink arbitrary shrink $
75 \tokens
76 -> canonicalizeTokens tokens `shouldBe` canonicalizeTokens (canonicalizeTokens tokens)