58 lines
1.9 KiB
Haskell
58 lines
1.9 KiB
Haskell
-- | Definitions for @GraphQL@ type system.
|
|
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
|