blob: c8a9997c622b1a612b1dd64ce59337087c6e4d76 (
plain)
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
|
-- | Definitions for @GraphQL@ input types.
module Language.GraphQL.Type
( Wrapping(..)
) where
import Data.Aeson as Aeson (ToJSON, toJSON)
import qualified Data.Aeson as Aeson
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
-- type can wrap other wrapping or named types. Wrapping types are lists and
-- Non-Null types (named types are nullable by default).
--
-- This 'Wrapping' type doesn\'t reflect this distinction exactly but it is
-- used in the resolvers to take into account that the returned value can be
-- nullable or an (arbitrary nested) list.
data Wrapping a
= List [Wrapping a] -- ^ Arbitrary nested list
| Named a -- ^ Named type without further wrapping
| Null -- ^ Null
deriving (Eq, Show)
instance Functor Wrapping where
fmap f (List list) = List $ fmap (fmap f) list
fmap f (Named named) = Named $ f named
fmap _ Null = Null
instance Foldable Wrapping where
foldr f acc (List list) = foldr (flip $ foldr f) acc list
foldr f acc (Named named) = f named acc
foldr _ acc Null = acc
instance Traversable Wrapping where
traverse f (List list) = List <$> traverse (traverse f) list
traverse f (Named named) = Named <$> f named
traverse _ Null = pure Null
instance Applicative Wrapping where
pure = Named
Null <*> _ = Null
_ <*> Null = Null
(Named f) <*> (Named x) = Named $ f x
(List fs) <*> (List xs) = List $ (<*>) <$> fs <*> xs
(Named f) <*> list = f <$> list
(List fs) <*> named = List $ (<*> named) <$> fs
instance Monad Wrapping where
return = pure
Null >>= _ = Null
(Named x) >>= f = f x
(List xs) >>= f = List $ fmap (>>= f) xs
instance ToJSON a => ToJSON (Wrapping a) where
toJSON (List list) = toJSON list
toJSON (Named named) = toJSON named
toJSON Null = Aeson.Null
|
