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
84
|
{-# LANGUAGE TupleSections #-}
-- | Contains definitions for generating 'Language's.
module Network.HTTP.Media.Language.Gen
( -- * Generating Languages
anything,
genLanguage,
genConcreteLanguage,
genDiffLanguage,
genMatchingLanguage,
genDiffMatchingLanguage,
genNonMatchingLanguage,
genMatchingLanguages,
genDiffMatchingLanguages,
genNonMatchingLanguages,
)
where
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import qualified Network.HTTP.Media.Gen as Gen
import Network.HTTP.Media.Language.Internal
import Test.QuickCheck.Gen
-- | The Language that matches anything.
anything :: Language
anything = Language []
-- | Generates any kind of Language.
genLanguage :: Gen Language
genLanguage = Language <$> listOf genCIByteString
-- | Generates a Language that does not match everything.
genConcreteLanguage :: Gen Language
genConcreteLanguage = Language <$> listOf1 genCIByteString
-- | Generates a different Language to the given one.
genDiffLanguage :: Language -> Gen Language
genDiffLanguage (Language []) = genConcreteLanguage
genDiffLanguage l = Gen.genDiffWith genLanguage l
-- | Generate a Language that has the given language as a prefix.
genMatchingLanguage :: Language -> Gen Language
genMatchingLanguage (Language pre) =
Language . (pre ++) <$> listOf genCIByteString
-- | Generate a Language that has the given language as a proper prefix.
genDiffMatchingLanguage :: Language -> Gen Language
genDiffMatchingLanguage (Language pre) =
Language . (pre ++) <$> listOf1 genCIByteString
-- | Generate a Language that does not have the given language as a prefix.
genNonMatchingLanguage :: Language -> Gen Language
genNonMatchingLanguage (Language []) = genConcreteLanguage
genNonMatchingLanguage (Language (pre : _)) = do
pre' <- genDiffCIByteString pre
genMatchingLanguage $ Language [pre']
-- | A private definition for generating pairs of languagues.
genLanguages :: (Language -> Gen Language) -> Gen (Language, Language)
genLanguages gen = do
pre <- genLanguage
(pre,) <$> gen pre
-- | Generate two languages, the first of which is a prefix of the second.
genMatchingLanguages :: Gen (Language, Language)
genMatchingLanguages = genLanguages genMatchingLanguage
-- | Generate two languages, the first of which is a proper prefix of the
-- second.
genDiffMatchingLanguages :: Gen (Language, Language)
genDiffMatchingLanguages = genLanguages genDiffMatchingLanguage
-- | Generate two languages, the first of which is not a prefix of the second.
genNonMatchingLanguages :: Gen (Language, Language)
genNonMatchingLanguages = do
pre <- genConcreteLanguage
(pre,) <$> genNonMatchingLanguage pre
genCIByteString :: Gen (CI ByteString)
genCIByteString = resize 8 Gen.genCIByteString
genDiffCIByteString :: CI ByteString -> Gen (CI ByteString)
genDiffCIByteString = Gen.genDiffWith genCIByteString
|
