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

module Data.Morpheus.Client.JSONSchema.Parse
  ( decodeIntrospection,
  )
where

import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Morpheus.Client.JSONSchema.TypeKind (TypeKind (..))
import qualified Data.Morpheus.Client.JSONSchema.TypeRef as Ref
import Data.Morpheus.Client.JSONSchema.Types
  ( EnumValue (..),
    Field (..),
    InputValue (..),
    Introspection (..),
    JSONResponse (..),
    Schema (..),
    Type (..),
  )
import Data.Morpheus.Core
  ( defaultConfig,
    validateSchema,
  )
import Data.Morpheus.Error (globalErrorMessage)
import Data.Morpheus.Internal.Ext
  ( Eventless,
  )
import Data.Morpheus.Internal.Utils
  ( Failure (..),
    fromElems,
  )
import qualified Data.Morpheus.Types.Internal.AST as AST
  ( Schema,
  )
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    ArgumentDefinition (..),
    CONST,
    DataTypeWrapper (..),
    FieldDefinition,
    IN,
    Message,
    OUT,
    OperationType (..),
    RootOperationTypeDefinition (..),
    SchemaDefinition (..),
    TypeContent (..),
    TypeDefinition (..),
    TypeName,
    TypeWrapper,
    VALID,
    ValidationErrors,
    buildSchema,
    createScalarType,
    mkEnumContent,
    mkInputValue,
    mkObjectField,
    mkType,
    mkUnionContent,
    msg,
    toAny,
    toHSWrappers,
  )
import Relude hiding
  ( ByteString,
    Type,
    fromList,
    show,
  )
import Prelude (show)

decoderError :: Message -> Eventless a
decoderError :: Message -> Eventless a
decoderError = GQLErrors -> Eventless a
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (GQLErrors -> Eventless a)
-> (Message -> GQLErrors) -> Message -> Eventless a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> GQLErrors
globalErrorMessage

decodeIntrospection :: ByteString -> Eventless (AST.Schema VALID)
decodeIntrospection :: ByteString -> Eventless (Schema VALID)
decodeIntrospection ByteString
jsonDoc = case Either String (JSONResponse Introspection)
jsonSchema of
  Left String
errors -> Message -> Eventless (Schema VALID)
forall a. Message -> Eventless a
decoderError (Message -> Eventless (Schema VALID))
-> Message -> Eventless (Schema VALID)
forall a b. (a -> b) -> a -> b
$ String -> Message
forall a. Msg a => a -> Message
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]
$sel:types:Schema :: Schema -> [Type]
types :: [Type]
types}
              }
      } -> do
      SchemaDefinition
schemaDef <- Schema -> Result () SchemaDefinition
forall (m :: * -> *).
(Monad m, Failure ValidationErrors 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 () [[TypeDefinition ANY CONST]]
-> Result () [TypeDefinition ANY CONST]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Result () [TypeDefinition ANY CONST])
-> [Type] -> Result () [[TypeDefinition ANY CONST]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type -> Result () [TypeDefinition ANY CONST]
forall a b. ParseJSONSchema a b => a -> Eventless b
parse [Type]
types
      (Maybe SchemaDefinition, [TypeDefinition ANY CONST],
 [DirectiveDefinition CONST])
-> Result () (Schema CONST)
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
(Maybe SchemaDefinition, [TypeDefinition ANY s],
 [DirectiveDefinition s])
-> m (Schema s)
buildSchema (SchemaDefinition -> Maybe SchemaDefinition
forall a. a -> Maybe a
Just SchemaDefinition
schemaDef, [TypeDefinition ANY CONST]
gqlTypes, [DirectiveDefinition CONST]
forall (f :: * -> *) a. Alternative f => f a
empty) Result () (Schema CONST)
-> (Schema CONST -> Eventless (Schema VALID))
-> Eventless (Schema VALID)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Schema CONST -> Eventless (Schema VALID)
validate
  Right JSONResponse Introspection
res -> Message -> Eventless (Schema VALID)
forall a. Message -> Eventless a
decoderError (String -> Message
forall a. Msg a => a -> Message
msg (String -> Message) -> String -> Message
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 -> Eventless (AST.Schema VALID)
    validate :: Schema CONST -> Eventless (Schema VALID)
validate = Bool -> Config -> Schema CONST -> Eventless (Schema VALID)
forall (s :: Stage).
ValidateSchema s =>
Bool -> Config -> Schema s -> Eventless (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, Failure ValidationErrors m) =>
  Schema ->
  m SchemaDefinition
mkSchemaDef :: Schema -> m SchemaDefinition
mkSchemaDef
  Schema
    { TypeRef
$sel:queryType:Schema :: Schema -> TypeRef
queryType :: TypeRef
queryType,
      Maybe TypeRef
$sel:mutationType:Schema :: Schema -> Maybe TypeRef
mutationType :: Maybe TypeRef
mutationType,
      Maybe TypeRef
$sel:subscriptionType:Schema :: Schema -> Maybe TypeRef
subscriptionType :: Maybe TypeRef
subscriptionType
    } =
    Directives CONST
-> OrdMap OperationType RootOperationTypeDefinition
-> SchemaDefinition
SchemaDefinition Directives CONST
forall (f :: * -> *) a. Alternative f => f a
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 k (m :: k -> *) a (coll :: k).
FromElems m a coll =>
[a] -> m coll
fromElems
        ( [Maybe RootOperationTypeDefinition]
-> [RootOperationTypeDefinition]
forall a. [Maybe a] -> [a]
catMaybes
            [ RootOperationTypeDefinition -> Maybe RootOperationTypeDefinition
forall a. a -> Maybe a
Just (OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Query (TypeName -> RootOperationTypeDefinition)
-> TypeName -> RootOperationTypeDefinition
forall a b. (a -> b) -> a -> b
$ TypeRef -> TypeName
Ref.name TypeRef
queryType),
              OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
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
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 -> Eventless b

instance ParseJSONSchema Type [TypeDefinition ANY CONST] where
  parse :: Type -> Result () [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 () [TypeDefinition ANY CONST]
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 () [TypeDefinition ANY CONST]
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 (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)
traverse Type -> Maybe TypeName
name [Type]
unions of
      Maybe [TypeName]
Nothing -> Message -> Result () [TypeDefinition ANY CONST]
forall a. Message -> Eventless a
decoderError Message
"ERROR: GQL ERROR"
      Just [TypeName]
uni -> [TypeDefinition ANY CONST] -> Result () [TypeDefinition ANY CONST]
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 () (FieldDefinition IN CONST))
-> [InputValue] -> Result () [FieldDefinition IN CONST]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse InputValue -> Result () (FieldDefinition IN CONST)
forall a b. ParseJSONSchema a b => a -> Eventless b
parse [InputValue]
iFields
      FieldsDefinition IN CONST
fs <- [FieldDefinition IN CONST] -> Result () (FieldsDefinition IN CONST)
forall k (m :: k -> *) a (coll :: k).
FromElems m a coll =>
[a] -> m coll
fromElems [FieldDefinition IN CONST]
fields
      [TypeDefinition ANY CONST] -> Result () [TypeDefinition ANY CONST]
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
$ FieldsDefinition IN CONST
-> TypeContent (INPUT_OBJECT <=? ANY) ANY CONST
forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> TypeContent (INPUT_OBJECT <=? a) a s
DataInputObject FieldsDefinition 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 () (FieldDefinition OUT CONST))
-> [Field] -> Result () [FieldDefinition OUT CONST]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Field -> Result () (FieldDefinition OUT CONST)
forall a b. ParseJSONSchema a b => a -> Eventless b
parse [Field]
oFields
      FieldsDefinition OUT CONST
fs <- [FieldDefinition OUT CONST]
-> Result () (FieldsDefinition OUT CONST)
forall k (m :: k -> *) a (coll :: k).
FromElems m a coll =>
[a] -> m coll
fromElems [FieldDefinition OUT CONST]
fields
      [TypeDefinition ANY CONST] -> Result () [TypeDefinition ANY CONST]
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]
-> FieldsDefinition OUT CONST
-> TypeContent (OBJECT <=? ANY) ANY CONST
forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (OBJECT <=? a) a s
DataObject [] FieldsDefinition OUT CONST
fs]
  parse Type
_ = [TypeDefinition ANY CONST] -> Result () [TypeDefinition ANY CONST]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

instance ParseJSONSchema Field (FieldDefinition OUT CONST) where
  parse :: Field -> Result () (FieldDefinition OUT CONST)
parse Field {FieldName
$sel:fieldName:Field :: Field -> FieldName
fieldName :: FieldName
fieldName, [InputValue]
$sel:fieldArgs:Field :: Field -> [InputValue]
fieldArgs :: [InputValue]
fieldArgs, Type
$sel:fieldType:Field :: Field -> Type
fieldType :: Type
fieldType} = do
    ([TypeWrapper]
wrappers, TypeName
typename) <- Type -> Eventless ([TypeWrapper], TypeName)
fieldTypeFromJSON Type
fieldType
    ArgumentsDefinition CONST
args <- (InputValue -> Result () (ArgumentDefinition CONST))
-> [InputValue] -> Result () [ArgumentDefinition CONST]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse InputValue -> Result () (ArgumentDefinition CONST)
forall (s :: Stage). InputValue -> Result () (ArgumentDefinition s)
genArg [InputValue]
fieldArgs Result () [ArgumentDefinition CONST]
-> ([ArgumentDefinition CONST]
    -> Result () (ArgumentsDefinition CONST))
-> Result () (ArgumentsDefinition CONST)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ArgumentDefinition CONST] -> Result () (ArgumentsDefinition CONST)
forall k (m :: k -> *) a (coll :: k).
FromElems m a coll =>
[a] -> m coll
fromElems
    FieldDefinition OUT CONST -> Result () (FieldDefinition OUT CONST)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldDefinition OUT CONST
 -> Result () (FieldDefinition OUT CONST))
-> FieldDefinition OUT CONST
-> Result () (FieldDefinition OUT CONST)
forall a b. (a -> b) -> a -> b
$ ArgumentsDefinition CONST
-> FieldName
-> [TypeWrapper]
-> TypeName
-> FieldDefinition OUT CONST
forall (s :: Stage).
ArgumentsDefinition s
-> FieldName -> [TypeWrapper] -> TypeName -> FieldDefinition OUT s
mkObjectField ArgumentsDefinition CONST
args FieldName
fieldName [TypeWrapper]
wrappers TypeName
typename
    where
      genArg :: InputValue -> Result () (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)
-> (([TypeWrapper], TypeName) -> FieldDefinition IN s)
-> ([TypeWrapper], TypeName)
-> ArgumentDefinition s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TypeWrapper] -> TypeName -> FieldDefinition IN s)
-> ([TypeWrapper], TypeName) -> FieldDefinition IN s
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (FieldName -> [TypeWrapper] -> TypeName -> FieldDefinition IN s
forall (cat :: TypeCategory) (s :: Stage).
FieldName -> [TypeWrapper] -> TypeName -> FieldDefinition cat s
mkInputValue FieldName
argName) (([TypeWrapper], TypeName) -> ArgumentDefinition s)
-> Eventless ([TypeWrapper], TypeName)
-> Result () (ArgumentDefinition s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Eventless ([TypeWrapper], TypeName)
fieldTypeFromJSON Type
argType

instance ParseJSONSchema InputValue (FieldDefinition IN CONST) where
  parse :: InputValue -> Result () (FieldDefinition IN CONST)
parse InputValue {FieldName
inputName :: FieldName
$sel:inputName:InputValue :: InputValue -> FieldName
inputName, Type
inputType :: Type
$sel:inputType:InputValue :: InputValue -> Type
inputType} = ([TypeWrapper] -> TypeName -> FieldDefinition IN CONST)
-> ([TypeWrapper], TypeName) -> FieldDefinition IN CONST
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (FieldName -> [TypeWrapper] -> TypeName -> FieldDefinition IN CONST
forall (cat :: TypeCategory) (s :: Stage).
FieldName -> [TypeWrapper] -> TypeName -> FieldDefinition cat s
mkInputValue FieldName
inputName) (([TypeWrapper], TypeName) -> FieldDefinition IN CONST)
-> Eventless ([TypeWrapper], TypeName)
-> Result () (FieldDefinition IN CONST)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Eventless ([TypeWrapper], TypeName)
fieldTypeFromJSON Type
inputType

fieldTypeFromJSON :: Type -> Eventless ([TypeWrapper], TypeName)
fieldTypeFromJSON :: Type -> Eventless ([TypeWrapper], TypeName)
fieldTypeFromJSON = (([DataTypeWrapper], TypeName) -> ([TypeWrapper], TypeName))
-> Result () ([DataTypeWrapper], TypeName)
-> Eventless ([TypeWrapper], TypeName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([DataTypeWrapper], TypeName) -> ([TypeWrapper], TypeName)
forall b. ([DataTypeWrapper], b) -> ([TypeWrapper], b)
toHs (Result () ([DataTypeWrapper], TypeName)
 -> Eventless ([TypeWrapper], TypeName))
-> (Type -> Result () ([DataTypeWrapper], TypeName))
-> Type
-> Eventless ([TypeWrapper], TypeName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DataTypeWrapper]
-> Type -> Result () ([DataTypeWrapper], TypeName)
fieldTypeRec []
  where
    toHs :: ([DataTypeWrapper], b) -> ([TypeWrapper], b)
toHs ([DataTypeWrapper]
w, b
t) = ([DataTypeWrapper] -> [TypeWrapper]
toHSWrappers [DataTypeWrapper]
w, b
t)
    fieldTypeRec ::
      [DataTypeWrapper] -> Type -> Eventless ([DataTypeWrapper], TypeName)
    fieldTypeRec :: [DataTypeWrapper]
-> Type -> Result () ([DataTypeWrapper], TypeName)
fieldTypeRec [DataTypeWrapper]
acc Type {$sel:kind:Type :: Type -> TypeKind
kind = TypeKind
LIST, $sel:ofType:Type :: Type -> Maybe Type
ofType = Just Type
ofType} =
      [DataTypeWrapper]
-> Type -> Result () ([DataTypeWrapper], TypeName)
fieldTypeRec (DataTypeWrapper
ListType DataTypeWrapper -> [DataTypeWrapper] -> [DataTypeWrapper]
forall a. a -> [a] -> [a]
: [DataTypeWrapper]
acc) Type
ofType
    fieldTypeRec [DataTypeWrapper]
acc Type {$sel:kind:Type :: Type -> TypeKind
kind = TypeKind
NON_NULL, $sel:ofType:Type :: Type -> Maybe Type
ofType = Just Type
ofType} =
      [DataTypeWrapper]
-> Type -> Result () ([DataTypeWrapper], TypeName)
fieldTypeRec (DataTypeWrapper
NonNullType DataTypeWrapper -> [DataTypeWrapper] -> [DataTypeWrapper]
forall a. a -> [a] -> [a]
: [DataTypeWrapper]
acc) Type
ofType
    fieldTypeRec [DataTypeWrapper]
acc Type {$sel:name:Type :: Type -> Maybe TypeName
name = Just TypeName
name} = ([DataTypeWrapper], TypeName)
-> Result () ([DataTypeWrapper], TypeName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DataTypeWrapper]
acc, TypeName
name)
    fieldTypeRec [DataTypeWrapper]
_ Type
x = Message -> Result () ([DataTypeWrapper], TypeName)
forall a. Message -> Eventless a
decoderError (Message -> Result () ([DataTypeWrapper], TypeName))
-> Message -> Result () ([DataTypeWrapper], TypeName)
forall a b. (a -> b) -> a -> b
$ Message
"Unsupported Field" Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> String -> Message
forall a. Msg a => a -> Message
msg (Type -> String
forall a. Show a => a -> String
show Type
x)