1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
module Network.HTTP.Media.Charset.Tests (tests) where
import Control.Monad (join)
import qualified Data.ByteString.Char8 as BS
import Data.String (fromString)
import Network.HTTP.Media.Accept
import Network.HTTP.Media.Charset (Charset)
import Network.HTTP.Media.Charset.Gen
import Network.HTTP.Media.RenderHeader
import Test.QuickCheck ((===))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
tests :: [TestTree]
tests =
[ testEq,
testShow,
testFromString,
testMatches,
testMoreSpecific,
testParseAccept
]
-- Equality is derived, but we test it here to get 100% coverage.
testEq :: TestTree
testEq =
testGroup
"Eq"
[ testProperty "==" $ do
enc <- genCharset
return $ enc === enc,
testProperty "/=" $ do
enc <- genCharset
enc' <- genDiffCharset enc
return $ enc /= enc'
]
testShow :: TestTree
testShow = testProperty "show" $ do
enc <- genCharset
return $ parseAccept (BS.pack $ show enc) === Just enc
testFromString :: TestTree
testFromString = testProperty "fromString" $ do
enc <- genCharset
return $ enc === fromString (show enc)
testMatches :: TestTree
testMatches =
testGroup
"matches"
[ testProperty "Equal values match" $
join matches <$> genCharset,
testProperty "* matches anything" $
flip matches anything <$> genCharset,
testProperty "No concrete encoding matches *" $
not . matches anything <$> genConcreteCharset
]
testMoreSpecific :: TestTree
testMoreSpecific =
testGroup
"moreSpecificThan"
[ testProperty "Against *" $
flip moreSpecificThan anything <$> genConcreteCharset,
testProperty "With *" $
not . moreSpecificThan anything <$> genConcreteCharset,
testProperty "Unrelated encodings" $
not . uncurry moreSpecificThan <$> genDiffConcreteCharsets
]
testParseAccept :: TestTree
testParseAccept =
testGroup
"parseAccept"
[ testProperty "Empty" $
parseAccept "" === (Nothing :: Maybe Charset),
testProperty "Wildcard" $
parseAccept "*" === Just anything,
testProperty "Valid parse" $ do
enc <- genCharset
return $ parseAccept (renderHeader enc) === Just enc
]
|
