{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Schema.JSON.Parse
  ( decodeIntrospection,
  )
where

import Control.Monad.Except (MonadError (throwError))
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Morpheus.Client.Schema.JSON.TypeKind (TypeKind (..))
import qualified Data.Morpheus.Client.Schema.JSON.TypeRef as Ref
import Data.Morpheus.Client.Schema.JSON.Types
  ( EnumValue (..),
    Field (..),
    InputValue (..),
    Introspection (..),
    JSONResponse (..),
    Schema (..),
    Type (..),
  )
import Data.Morpheus.Core
  ( defaultConfig,
    validateSchema,
  )
import Data.Morpheus.Internal.Ext
  ( GQLResult,
  )
import Data.Morpheus.Internal.Utils
  ( empty,
    fromElems,
  )
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    ArgumentDefinition (..),
    CONST,
    FieldDefinition,
    GQLError,
    IN,
    OUT,
    OperationType (..),
    RootOperationTypeDefinition (..),
    SchemaDefinition (..),
    TypeContent (..),
    TypeDefinition (..),
    TypeRef (..),
    TypeWrapper (..),
    VALID,
    buildSchema,
    createScalarType,
    mkEnumContent,
    mkField,
    mkMaybeType,
    mkObjectField,
    mkType,
    mkUnionContent,
    msg,
    toAny,
  )
import qualified Data.Morpheus.Types.Internal.AST as AST
  ( Schema,
  )
import Relude hiding
  ( ByteString,
    Type,
    empty,
    fromList,
    show,
  )
import Prelude (show)

decoderError :: GQLError -> GQLResult a
decoderError :: forall a. GQLError -> GQLResult a
decoderError = GQLError -> Result GQLError a
forall a. GQLError -> GQLResult a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

decodeIntrospection :: ByteString -> GQLResult (AST.Schema VALID)
decodeIntrospection :: ByteString -> GQLResult (Schema VALID)
decodeIntrospection ByteString
jsonDoc = case Either String (JSONResponse Introspection)
jsonSchema of
  Left String
errors -> GQLError -> GQLResult (Schema VALID)
forall a. GQLError -> GQLResult a
decoderError (GQLError -> GQLResult (Schema VALID))
-> GQLError -> GQLResult (Schema VALID)
forall a b. (a -> b) -> a -> b
$ String -> GQLError
forall a. Msg a => a -> GQLError
msg String
errors
  Right
    JSONResponse
      { $sel:responseData:JSONResponse :: forall a. JSONResponse a -> Maybe a
responseData =
          Just
            Introspection
              { $sel:__schema:Introspection :: Introspection -> Schema
__schema =
                  schema :: Schema
schema@Schema {[Type]
types :: [Type]
$sel:types:Schema :: Schema -> [Type]
types}
              }
      } -> do
      SchemaDefinition
schemaDef <- Schema -> Result GQLError SchemaDefinition
forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
Schema -> m SchemaDefinition
mkSchemaDef Schema
schema
      [TypeDefinition ANY CONST]
gqlTypes <- [[TypeDefinition ANY CONST]] -> [TypeDefinition ANY CONST]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TypeDefinition ANY CONST]] -> [TypeDefinition ANY CONST])
-> Result GQLError [[TypeDefinition ANY CONST]]
-> Result GQLError [TypeDefinition ANY CONST]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Result GQLError [TypeDefinition ANY CONST])
-> [Type] -> Result GQLError [[TypeDefinition ANY CONST]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Type -> Result GQLError [TypeDefinition ANY CONST]
forall a b. ParseJSONSchema a b => a -> GQLResult b
parse [Type]
types
      (Maybe SchemaDefinition, [TypeDefinition ANY CONST],
 DirectivesDefinition CONST)
-> Result GQLError (Schema CONST)
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
(Maybe SchemaDefinition, [TypeDefinition ANY s],
 DirectivesDefinition s)
-> m (Schema s)
buildSchema (SchemaDefinition -> Maybe SchemaDefinition
forall a. a -> Maybe a
Just SchemaDefinition
schemaDef, [TypeDefinition ANY CONST]
gqlTypes, DirectivesDefinition CONST
forall coll. Empty coll => coll
empty) Result GQLError (Schema CONST)
-> (Schema CONST -> GQLResult (Schema VALID))
-> GQLResult (Schema VALID)
forall a b.
Result GQLError a -> (a -> Result GQLError b) -> Result GQLError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Schema CONST -> GQLResult (Schema VALID)
validate
  Right JSONResponse Introspection
res -> GQLError -> GQLResult (Schema VALID)
forall a. GQLError -> GQLResult a
decoderError (String -> GQLError
forall a. Msg a => a -> GQLError
msg (String -> GQLError) -> String -> GQLError
forall a b. (a -> b) -> a -> b
$ JSONResponse Introspection -> String
forall a. Show a => a -> String
show JSONResponse Introspection
res)
  where
    validate :: AST.Schema CONST -> GQLResult (AST.Schema VALID)
    validate :: Schema CONST -> GQLResult (Schema VALID)
validate = Bool -> Config -> Schema CONST -> GQLResult (Schema VALID)
forall (s :: Stage).
ValidateSchema s =>
Bool -> Config -> Schema s -> GQLResult (Schema VALID)
validateSchema Bool
False Config
defaultConfig
    jsonSchema :: Either String (JSONResponse Introspection)
    jsonSchema :: Either String (JSONResponse Introspection)
jsonSchema = ByteString -> Either String (JSONResponse Introspection)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
jsonDoc

mkSchemaDef ::
  (Monad m, MonadError GQLError m) =>
  Schema ->
  m SchemaDefinition
mkSchemaDef :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
Schema -> m SchemaDefinition
mkSchemaDef
  Schema
    { TypeRef
queryType :: TypeRef
$sel:queryType:Schema :: Schema -> TypeRef
queryType,
      Maybe TypeRef
mutationType :: Maybe TypeRef
$sel:mutationType:Schema :: Schema -> Maybe TypeRef
mutationType,
      Maybe TypeRef
subscriptionType :: Maybe TypeRef
$sel:subscriptionType:Schema :: Schema -> Maybe TypeRef
subscriptionType
    } =
    Directives CONST
-> OrdMap OperationType RootOperationTypeDefinition
-> SchemaDefinition
SchemaDefinition Directives CONST
forall coll. Empty coll => coll
empty
      (OrdMap OperationType RootOperationTypeDefinition
 -> SchemaDefinition)
-> m (OrdMap OperationType RootOperationTypeDefinition)
-> m SchemaDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RootOperationTypeDefinition]
-> m (OrdMap OperationType RootOperationTypeDefinition)
forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems
        ( [Maybe RootOperationTypeDefinition]
-> [RootOperationTypeDefinition]
forall a. [Maybe a] -> [a]
catMaybes
            [ RootOperationTypeDefinition -> Maybe RootOperationTypeDefinition
forall a. a -> Maybe a
Just (OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
OPERATION_QUERY (TypeName -> RootOperationTypeDefinition)
-> TypeName -> RootOperationTypeDefinition
forall a b. (a -> b) -> a -> b
$ TypeRef -> TypeName
Ref.name TypeRef
queryType),
              OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
OPERATION_MUTATION (TypeName -> RootOperationTypeDefinition)
-> (TypeRef -> TypeName) -> TypeRef -> RootOperationTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> TypeName
Ref.name (TypeRef -> RootOperationTypeDefinition)
-> Maybe TypeRef -> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TypeRef
mutationType,
              OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
OPERATION_SUBSCRIPTION (TypeName -> RootOperationTypeDefinition)
-> (TypeRef -> TypeName) -> TypeRef -> RootOperationTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> TypeName
Ref.name (TypeRef -> RootOperationTypeDefinition)
-> Maybe TypeRef -> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TypeRef
subscriptionType
            ]
        )

class ParseJSONSchema a b where
  parse :: a -> GQLResult b

instance ParseJSONSchema Type [TypeDefinition ANY CONST] where
  parse :: Type -> Result GQLError [TypeDefinition ANY CONST]
parse Type {$sel:name:Type :: Type -> Maybe TypeName
name = Just TypeName
typeName, $sel:kind:Type :: Type -> TypeKind
kind = TypeKind
SCALAR} =
    [TypeDefinition ANY CONST]
-> Result GQLError [TypeDefinition ANY CONST]
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeName -> TypeDefinition ANY CONST
forall (a :: TypeCategory) (s :: Stage).
(LEAF <=! a) =>
TypeName -> TypeDefinition a s
createScalarType TypeName
typeName]
  parse Type {$sel:name:Type :: Type -> Maybe TypeName
name = Just TypeName
typeName, $sel:kind:Type :: Type -> TypeKind
kind = TypeKind
ENUM, $sel:enumValues:Type :: Type -> Maybe [EnumValue]
enumValues = Just [EnumValue]
enums} =
    [TypeDefinition ANY CONST]
-> Result GQLError [TypeDefinition ANY CONST]
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeName -> TypeContent TRUE ANY CONST -> TypeDefinition ANY CONST
forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName (TypeContent TRUE ANY CONST -> TypeDefinition ANY CONST)
-> TypeContent TRUE ANY CONST -> TypeDefinition ANY CONST
forall a b. (a -> b) -> a -> b
$ [TypeName] -> TypeContent TRUE ANY CONST
forall (a :: TypeCategory) (s :: Stage).
(LEAF <=! a) =>
[TypeName] -> TypeContent TRUE a s
mkEnumContent ((EnumValue -> TypeName) -> [EnumValue] -> [TypeName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EnumValue -> TypeName
enumName [EnumValue]
enums)]
  parse Type {$sel:name:Type :: Type -> Maybe TypeName
name = Just TypeName
typeName, $sel:kind:Type :: Type -> TypeKind
kind = TypeKind
UNION, $sel:possibleTypes:Type :: Type -> Maybe [Type]
possibleTypes = Just [Type]
unions} =
    case (Type -> Maybe TypeName) -> [Type] -> Maybe [TypeName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Type -> Maybe TypeName
name [Type]
unions of
      Maybe [TypeName]
Nothing -> GQLError -> Result GQLError [TypeDefinition ANY CONST]
forall a. GQLError -> GQLResult a
decoderError GQLError
"ERROR: GQL ERROR"
      Just [TypeName]
uni -> [TypeDefinition ANY CONST]
-> Result GQLError [TypeDefinition ANY CONST]
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeDefinition OUT CONST -> TypeDefinition ANY CONST
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny (TypeDefinition OUT CONST -> TypeDefinition ANY CONST)
-> TypeDefinition OUT CONST -> TypeDefinition ANY CONST
forall a b. (a -> b) -> a -> b
$ TypeName -> TypeContent TRUE OUT CONST -> TypeDefinition OUT CONST
forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName (TypeContent TRUE OUT CONST -> TypeDefinition OUT CONST)
-> TypeContent TRUE OUT CONST -> TypeDefinition OUT CONST
forall a b. (a -> b) -> a -> b
$ [TypeName] -> TypeContent TRUE OUT CONST
forall (s :: Stage). [TypeName] -> TypeContent TRUE OUT s
mkUnionContent [TypeName]
uni]
  parse Type {$sel:name:Type :: Type -> Maybe TypeName
name = Just TypeName
typeName, $sel:kind:Type :: Type -> TypeKind
kind = TypeKind
INPUT_OBJECT, $sel:inputFields:Type :: Type -> Maybe [InputValue]
inputFields = Just [InputValue]
iFields} =
    do
      ([FieldDefinition IN CONST]
fields :: [FieldDefinition IN CONST]) <- (InputValue -> Result GQLError (FieldDefinition IN CONST))
-> [InputValue] -> Result GQLError [FieldDefinition IN CONST]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse InputValue -> Result GQLError (FieldDefinition IN CONST)
forall a b. ParseJSONSchema a b => a -> GQLResult b
parse [InputValue]
iFields
      OrdMap FieldName (FieldDefinition IN CONST)
fs <- [FieldDefinition IN CONST]
-> Result GQLError (OrdMap FieldName (FieldDefinition IN CONST))
forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems [FieldDefinition IN CONST]
fields
      [TypeDefinition ANY CONST]
-> Result GQLError [TypeDefinition ANY CONST]
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeName -> TypeContent TRUE ANY CONST -> TypeDefinition ANY CONST
forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName (TypeContent TRUE ANY CONST -> TypeDefinition ANY CONST)
-> TypeContent TRUE ANY CONST -> TypeDefinition ANY CONST
forall a b. (a -> b) -> a -> b
$ OrdMap FieldName (FieldDefinition IN CONST)
-> TypeContent (INPUT_OBJECT <=? ANY) ANY CONST
forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> TypeContent (INPUT_OBJECT <=? a) a s
DataInputObject OrdMap FieldName (FieldDefinition IN CONST)
fs]
  parse Type {$sel:name:Type :: Type -> Maybe TypeName
name = Just TypeName
typeName, $sel:kind:Type :: Type -> TypeKind
kind = TypeKind
OBJECT, $sel:fields:Type :: Type -> Maybe [Field]
fields = Just [Field]
oFields} =
    do
      ([FieldDefinition OUT CONST]
fields :: [FieldDefinition OUT CONST]) <- (Field -> Result GQLError (FieldDefinition OUT CONST))
-> [Field] -> Result GQLError [FieldDefinition OUT CONST]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Field -> Result GQLError (FieldDefinition OUT CONST)
forall a b. ParseJSONSchema a b => a -> GQLResult b
parse [Field]
oFields
      OrdMap FieldName (FieldDefinition OUT CONST)
fs <- [FieldDefinition OUT CONST]
-> Result GQLError (OrdMap FieldName (FieldDefinition OUT CONST))
forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems [FieldDefinition OUT CONST]
fields
      [TypeDefinition ANY CONST]
-> Result GQLError [TypeDefinition ANY CONST]
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeName -> TypeContent TRUE ANY CONST -> TypeDefinition ANY CONST
forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName (TypeContent TRUE ANY CONST -> TypeDefinition ANY CONST)
-> TypeContent TRUE ANY CONST -> TypeDefinition ANY CONST
forall a b. (a -> b) -> a -> b
$ [TypeName]
-> OrdMap FieldName (FieldDefinition OUT CONST)
-> TypeContent (OBJECT <=? ANY) ANY CONST
forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (OBJECT <=? a) a s
DataObject [] OrdMap FieldName (FieldDefinition OUT CONST)
fs]
  parse Type
_ = [TypeDefinition ANY CONST]
-> Result GQLError [TypeDefinition ANY CONST]
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

instance ParseJSONSchema Field (FieldDefinition OUT CONST) where
  parse :: Field -> Result GQLError (FieldDefinition OUT CONST)
parse Field {FieldName
fieldName :: FieldName
$sel:fieldName:Field :: Field -> FieldName
fieldName, [InputValue]
fieldArgs :: [InputValue]
$sel:fieldArgs:Field :: Field -> [InputValue]
fieldArgs, Type
fieldType :: Type
$sel:fieldType:Field :: Field -> Type
fieldType} = do
    TypeRef TypeName
typename TypeWrapper
wrappers <- Type -> GQLResult TypeRef
fieldTypeFromJSON Type
fieldType
    OrdMap FieldName (ArgumentDefinition CONST)
args <- (InputValue -> Result GQLError (ArgumentDefinition CONST))
-> [InputValue] -> Result GQLError [ArgumentDefinition CONST]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse InputValue -> Result GQLError (ArgumentDefinition CONST)
forall {s :: Stage}.
InputValue -> Result GQLError (ArgumentDefinition s)
genArg [InputValue]
fieldArgs Result GQLError [ArgumentDefinition CONST]
-> ([ArgumentDefinition CONST]
    -> Result GQLError (OrdMap FieldName (ArgumentDefinition CONST)))
-> Result GQLError (OrdMap FieldName (ArgumentDefinition CONST))
forall a b.
Result GQLError a -> (a -> Result GQLError b) -> Result GQLError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ArgumentDefinition CONST]
-> Result GQLError (OrdMap FieldName (ArgumentDefinition CONST))
forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems
    FieldDefinition OUT CONST
-> Result GQLError (FieldDefinition OUT CONST)
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldDefinition OUT CONST
 -> Result GQLError (FieldDefinition OUT CONST))
-> FieldDefinition OUT CONST
-> Result GQLError (FieldDefinition OUT CONST)
forall a b. (a -> b) -> a -> b
$ OrdMap FieldName (ArgumentDefinition CONST)
-> FieldName
-> TypeWrapper
-> TypeName
-> FieldDefinition OUT CONST
forall (s :: Stage).
ArgumentsDefinition s
-> FieldName -> TypeWrapper -> TypeName -> FieldDefinition OUT s
mkObjectField OrdMap FieldName (ArgumentDefinition CONST)
args FieldName
fieldName TypeWrapper
wrappers TypeName
typename
    where
      genArg :: InputValue -> Result GQLError (ArgumentDefinition s)
genArg InputValue {$sel:inputName:InputValue :: InputValue -> FieldName
inputName = FieldName
argName, $sel:inputType:InputValue :: InputValue -> Type
inputType = Type
argType} =
        FieldDefinition IN s -> ArgumentDefinition s
forall (s :: Stage). FieldDefinition IN s -> ArgumentDefinition s
ArgumentDefinition (FieldDefinition IN s -> ArgumentDefinition s)
-> (TypeRef -> FieldDefinition IN s)
-> TypeRef
-> ArgumentDefinition s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (FieldContent TRUE IN s)
-> FieldName -> TypeRef -> FieldDefinition IN s
forall (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent TRUE cat s)
-> FieldName -> TypeRef -> FieldDefinition cat s
mkField Maybe (FieldContent TRUE IN s)
forall a. Maybe a
Nothing FieldName
argName (TypeRef -> ArgumentDefinition s)
-> GQLResult TypeRef -> Result GQLError (ArgumentDefinition s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> GQLResult TypeRef
fieldTypeFromJSON Type
argType

instance ParseJSONSchema InputValue (FieldDefinition IN CONST) where
  parse :: InputValue -> Result GQLError (FieldDefinition IN CONST)
parse InputValue {FieldName
$sel:inputName:InputValue :: InputValue -> FieldName
inputName :: FieldName
inputName, Type
$sel:inputType:InputValue :: InputValue -> Type
inputType :: Type
inputType} = Maybe (FieldContent TRUE IN CONST)
-> FieldName -> TypeRef -> FieldDefinition IN CONST
forall (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent TRUE cat s)
-> FieldName -> TypeRef -> FieldDefinition cat s
mkField Maybe (FieldContent TRUE IN CONST)
forall a. Maybe a
Nothing FieldName
inputName (TypeRef -> FieldDefinition IN CONST)
-> GQLResult TypeRef -> Result GQLError (FieldDefinition IN CONST)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> GQLResult TypeRef
fieldTypeFromJSON Type
inputType

fieldTypeFromJSON :: Type -> GQLResult TypeRef
fieldTypeFromJSON :: Type -> GQLResult TypeRef
fieldTypeFromJSON Type {$sel:kind:Type :: Type -> TypeKind
kind = TypeKind
NON_NULL, $sel:ofType:Type :: Type -> Maybe Type
ofType = Just Type
ofType} = TypeRef -> TypeRef
withListNonNull (TypeRef -> TypeRef) -> GQLResult TypeRef -> GQLResult TypeRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> GQLResult TypeRef
fieldTypeFromJSON Type
ofType
fieldTypeFromJSON Type {$sel:kind:Type :: Type -> TypeKind
kind = TypeKind
LIST, $sel:ofType:Type :: Type -> Maybe Type
ofType = Just Type
ofType} = TypeRef -> TypeRef
withList (TypeRef -> TypeRef) -> GQLResult TypeRef -> GQLResult TypeRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> GQLResult TypeRef
fieldTypeFromJSON Type
ofType
fieldTypeFromJSON Type {$sel:name:Type :: Type -> Maybe TypeName
name = Just TypeName
name} = TypeRef -> GQLResult TypeRef
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeName -> TypeWrapper -> TypeRef
TypeRef TypeName
name TypeWrapper
mkMaybeType)
fieldTypeFromJSON Type
x = GQLError -> GQLResult TypeRef
forall a. GQLError -> GQLResult a
decoderError (GQLError -> GQLResult TypeRef) -> GQLError -> GQLResult TypeRef
forall a b. (a -> b) -> a -> b
$ GQLError
"Unsupported Field" GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> String -> GQLError
forall a. Msg a => a -> GQLError
msg (Type -> String
forall a. Show a => a -> String
show Type
x)

withList :: TypeRef -> TypeRef
withList :: TypeRef -> TypeRef
withList (TypeRef TypeName
name TypeWrapper
x) = TypeName -> TypeWrapper -> TypeRef
TypeRef TypeName
name (TypeWrapper -> Bool -> TypeWrapper
TypeList TypeWrapper
x Bool
False)

withListNonNull :: TypeRef -> TypeRef
withListNonNull :: TypeRef -> TypeRef
withListNonNull (TypeRef TypeName
name (TypeList TypeWrapper
y Bool
_)) = TypeName -> TypeWrapper -> TypeRef
TypeRef TypeName
name (TypeWrapper -> Bool -> TypeWrapper
TypeList TypeWrapper
y Bool
True)
withListNonNull (TypeRef TypeName
name (BaseType Bool
_)) = TypeName -> TypeWrapper -> TypeRef
TypeRef TypeName
name (Bool -> TypeWrapper
BaseType Bool
True)