git.iko.soy/typeable/html-parse
on 63aa05c help sign in
typeable/html-parse/tests/Text/HTML/ParserSpec.hs
74 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 qualified Data.Text as T
13import qualified Data.Text.Lazy as TL
14import qualified Data.Text.Lazy.Builder as B
15import Test.Hspec
16import Test.QuickCheck
17import Test.QuickCheck.Instances ()
18import Text.HTML.Parser
21instance Arbitrary Token where
22 arbitrary = oneof [validOpen, validClose, validFlat]
24 shrink (TagOpen n as) = TagOpen n <$> shrink as
25 shrink (TagClose _) = []
26 shrink (ContentText _) = []
27 shrink (ContentChar _) = []
28 shrink (Comment b) = Comment . B.fromText <$> (shrink . TL.toStrict . B.toLazyText $ b)
29 shrink (Doctype t) = Doctype <$> shrink t
31instance Arbitrary Attr where
32 arbitrary = Attr <$> validXmlTag <*> validXmlText
33 shrink (Attr k v) = Attr <$> shrink k <*> shrink v
35validOpen :: Gen Token
36validOpen = TagOpen <$> validXmlTag <*> arbitrary
38validClose :: Gen Token
39validClose = TagClose <$> validXmlTag
41validFlat :: Gen Token
42validFlat = oneof
43 [ ContentChar <$> validXmlChar
44 , ContentText <$> validXmlText
45 , Comment . B.fromText <$> validXmlText
46 , Doctype <$> validXmlText
47 ]
49validXmlChar :: Gen Char
50validXmlChar = elements (' ' : ['a'..'z']) -- FIXME: generate wider range of values
52validXmlTag :: Gen T.Text
53validXmlTag = T.pack <$> sized (`maxListOf1` elements ['a'..'z']) -- FIXME: generate wider range of values
55validXmlText :: Gen T.Text
56validXmlText = mconcat <$> sized (`maxListOf` (T.cons <$> validXmlChar <*> validXmlTag)) -- FIXME: generate wider range of values
58maxListOf :: Int -> Gen a -> Gen [a]
59maxListOf n g = take n <$> listOf g
61maxListOf1 :: Int -> Gen a -> Gen [a]
62maxListOf1 (min 1 -> n) g = take n <$> listOf1 g
66spec :: Spec
67spec = do
68 it "parseTokens and renderTokens are inverse" . property . forAllShrink arbitrary shrink $
69 \(canonicalizeTokens -> tokens)
70 -> (parseTokens . TL.toStrict . renderTokens $ tokens) `shouldBe` tokens
72 it "canonicalizeTokens is idempotent" . property . forAllShrink arbitrary shrink $
73 \tokens
74 -> canonicalizeTokens tokens `shouldBe` canonicalizeTokens (canonicalizeTokens tokens)