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
|
{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.AST.Arbitrary 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, pack)
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 (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 (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 = 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
]
where
variableGen :: Gen Doc.Value
variableGen = Doc.Variable <$> (getAnyName <$> arbitrary)
listGen :: Gen [Doc.Node Doc.Value]
listGen = (resize 5 . listOf) nodeGen
nodeGen = do
node' <- getAnyNode <$> (arbitrary :: Gen (AnyNode AnyValue))
pure (getAnyValue <$> node')
objectGen :: Gen [Doc.ObjectField Doc.Value]
objectGen = resize 1 $ do
list <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList (AnyObjectField AnyValue)))
pure $ map (fmap getAnyValue . getAnyObjectField) list
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' <> ": " <> (pack . show) value'
|
