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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.AST.Arbitrary
( AnyArgument(..)
, AnyLocation(..)
, AnyName(..)
, AnyNode(..)
, AnyObjectField(..)
, AnyValue(..)
, printArgument
) where
import qualified Language.GraphQL.AST.Document as Doc
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..))
import Test.QuickCheck.Gen (Gen (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Functor ((<&>))
newtype AnyPrintableChar = AnyPrintableChar
{ getAnyPrintableChar :: Char
} deriving (Eq, Show)
alpha :: String
alpha = ['a'..'z'] <> ['A'..'Z']
num :: String
num = ['0'..'9']
instance Arbitrary AnyPrintableChar where
arbitrary = AnyPrintableChar <$> elements chars
where
chars = alpha <> num <> ['_']
newtype AnyPrintableText = AnyPrintableText
{ getAnyPrintableText :: Text
} deriving (Eq, Show)
instance Arbitrary AnyPrintableText where
arbitrary = do
nonEmptyStr <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList AnyPrintableChar))
pure $ AnyPrintableText
$ Text.pack
$ map getAnyPrintableChar nonEmptyStr
-- https://spec.graphql.org/June2018/#Name
newtype AnyName = AnyName
{ getAnyName :: Text
} deriving (Eq, Show)
instance Arbitrary AnyName where
arbitrary = do
firstChar <- elements $ alpha <> ['_']
rest <- (arbitrary :: Gen [AnyPrintableChar])
pure $ AnyName
$ Text.pack
$ firstChar : map getAnyPrintableChar rest
newtype AnyLocation = AnyLocation
{ getAnyLocation :: Doc.Location
} deriving (Eq, Show)
instance Arbitrary AnyLocation where
arbitrary = AnyLocation <$> (Doc.Location <$> arbitrary <*> arbitrary)
newtype AnyNode a = AnyNode
{ getAnyNode :: Doc.Node a
} deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyNode a) where
arbitrary = do
(AnyLocation location') <- arbitrary
node' <- flip Doc.Node location' <$> arbitrary
pure $ AnyNode node'
newtype AnyObjectField a = AnyObjectField
{ getAnyObjectField :: Doc.ObjectField a
} deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyObjectField a) where
arbitrary = do
name' <- getAnyName <$> arbitrary
value' <- getAnyNode <$> arbitrary
location' <- getAnyLocation <$> arbitrary
pure $ AnyObjectField $ Doc.ObjectField name' value' location'
newtype AnyValue = AnyValue
{ getAnyValue :: Doc.Value
} deriving (Eq, Show)
instance Arbitrary AnyValue
where
arbitrary =
let variableGen :: Gen Doc.Value
variableGen = Doc.Variable . getAnyName <$> arbitrary
listGen :: Gen [Doc.Node Doc.Value]
listGen = (resize 5 . listOf) nodeGen
nodeGen :: Gen (Doc.Node Doc.Value)
nodeGen = fmap getAnyNode arbitrary <&> fmap getAnyValue
objectGen :: Gen [Doc.ObjectField Doc.Value]
objectGen = resize 1
$ fmap getNonEmpty arbitrary
<&> map (fmap getAnyValue . getAnyObjectField)
in AnyValue <$> oneof
[ variableGen
, Doc.Int <$> arbitrary
, Doc.Float <$> arbitrary
, Doc.String . getAnyPrintableText <$> arbitrary
, Doc.Boolean <$> arbitrary
, MkGen $ \_ _ -> Doc.Null
, Doc.Enum . getAnyName <$> arbitrary
, Doc.List <$> listGen
, Doc.Object <$> objectGen
]
newtype AnyArgument a = AnyArgument
{ getAnyArgument :: Doc.Argument
} deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyArgument a) where
arbitrary = do
name' <- getAnyName <$> arbitrary
(AnyValue value') <- arbitrary
(AnyLocation location') <- arbitrary
pure $ AnyArgument $ Doc.Argument name' (Doc.Node value' location') location'
printArgument :: AnyArgument AnyValue -> Text
printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) =
name' <> ": " <> (Text.pack . show) value'
|
