{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Schema.JSON.Types
  ( Introspection (..),
    Schema (..),
    Type (..),
    Field (..),
    InputValue (..),
    EnumValue (..),
    JSONResponse (..),
  )
where

import Data.Aeson
--
-- MORPHEUS
import Data.Morpheus.Client.Schema.JSON.TypeKind (TypeKind)
import Data.Morpheus.Client.Schema.JSON.TypeRef (TypeRef)
import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    GQLError,
    TypeName,
  )
import Relude hiding (Type)

-- TYPES FOR DECODING JSON INTROSPECTION
--
newtype Introspection = Introspection
  { Introspection -> Schema
__schema :: Schema
  }
  deriving (forall x. Rep Introspection x -> Introspection
forall x. Introspection -> Rep Introspection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Introspection x -> Introspection
$cfrom :: forall x. Introspection -> Rep Introspection x
Generic, Int -> Introspection -> ShowS
[Introspection] -> ShowS
Introspection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Introspection] -> ShowS
$cshowList :: [Introspection] -> ShowS
show :: Introspection -> String
$cshow :: Introspection -> String
showsPrec :: Int -> Introspection -> ShowS
$cshowsPrec :: Int -> Introspection -> ShowS
Show, Value -> Parser [Introspection]
Value -> Parser Introspection
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Introspection]
$cparseJSONList :: Value -> Parser [Introspection]
parseJSON :: Value -> Parser Introspection
$cparseJSON :: Value -> Parser Introspection
FromJSON)

data Schema = Schema
  { Schema -> [Type]
types :: [Type],
    Schema -> TypeRef
queryType :: TypeRef,
    Schema -> Maybe TypeRef
mutationType :: Maybe TypeRef,
    Schema -> Maybe TypeRef
subscriptionType :: Maybe TypeRef
  }
  deriving (forall x. Rep Schema x -> Schema
forall x. Schema -> Rep Schema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Schema x -> Schema
$cfrom :: forall x. Schema -> Rep Schema x
Generic, Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schema] -> ShowS
$cshowList :: [Schema] -> ShowS
show :: Schema -> String
$cshow :: Schema -> String
showsPrec :: Int -> Schema -> ShowS
$cshowsPrec :: Int -> Schema -> ShowS
Show, Value -> Parser [Schema]
Value -> Parser Schema
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Schema]
$cparseJSONList :: Value -> Parser [Schema]
parseJSON :: Value -> Parser Schema
$cparseJSON :: Value -> Parser Schema
FromJSON)

data Type = Type
  { Type -> TypeKind
kind :: TypeKind,
    Type -> Maybe TypeName
name :: Maybe TypeName,
    Type -> Maybe [Field]
fields :: Maybe [Field],
    Type -> Maybe [Type]
interfaces :: Maybe [Type],
    Type -> Maybe [Type]
possibleTypes :: Maybe [Type],
    Type -> Maybe [EnumValue]
enumValues :: Maybe [EnumValue],
    Type -> Maybe [InputValue]
inputFields :: Maybe [InputValue],
    Type -> Maybe Type
ofType :: Maybe Type
  }
  deriving (forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
Generic, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Value -> Parser [Type]
Value -> Parser Type
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Type]
$cparseJSONList :: Value -> Parser [Type]
parseJSON :: Value -> Parser Type
$cparseJSON :: Value -> Parser Type
FromJSON)

-- FIELD
data Field = Field
  { Field -> FieldName
fieldName :: FieldName,
    Field -> [InputValue]
fieldArgs :: [InputValue],
    Field -> Type
fieldType :: Type
  }
  deriving (Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show, forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field x -> Field
$cfrom :: forall x. Field -> Rep Field x
Generic)

instance FromJSON Field where
  parseJSON :: Value -> Parser Field
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Field" Object -> Parser Field
objectParser
    where
      objectParser :: Object -> Parser Field
objectParser Object
o = FieldName -> [InputValue] -> Type -> Field
Field forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"args" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

-- INPUT
data InputValue = InputValue
  { InputValue -> FieldName
inputName :: FieldName,
    InputValue -> Type
inputType :: Type
  }
  deriving (Int -> InputValue -> ShowS
[InputValue] -> ShowS
InputValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputValue] -> ShowS
$cshowList :: [InputValue] -> ShowS
show :: InputValue -> String
$cshow :: InputValue -> String
showsPrec :: Int -> InputValue -> ShowS
$cshowsPrec :: Int -> InputValue -> ShowS
Show, forall x. Rep InputValue x -> InputValue
forall x. InputValue -> Rep InputValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputValue x -> InputValue
$cfrom :: forall x. InputValue -> Rep InputValue x
Generic)

instance FromJSON InputValue where
  parseJSON :: Value -> Parser InputValue
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InputValue" Object -> Parser InputValue
objectParser
    where
      objectParser :: Object -> Parser InputValue
objectParser Object
o = FieldName -> Type -> InputValue
InputValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

-- ENUM
newtype EnumValue = EnumValue
  { EnumValue -> TypeName
enumName :: TypeName
  }
  deriving (forall x. Rep EnumValue x -> EnumValue
forall x. EnumValue -> Rep EnumValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnumValue x -> EnumValue
$cfrom :: forall x. EnumValue -> Rep EnumValue x
Generic, Int -> EnumValue -> ShowS
[EnumValue] -> ShowS
EnumValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumValue] -> ShowS
$cshowList :: [EnumValue] -> ShowS
show :: EnumValue -> String
$cshow :: EnumValue -> String
showsPrec :: Int -> EnumValue -> ShowS
$cshowsPrec :: Int -> EnumValue -> ShowS
Show)

instance FromJSON EnumValue where
  parseJSON :: Value -> Parser EnumValue
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"EnumValue" Object -> Parser EnumValue
objectParser
    where
      objectParser :: Object -> Parser EnumValue
objectParser Object
o = TypeName -> EnumValue
EnumValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

instance FromJSON a => FromJSON (JSONResponse a) where
  parseJSON :: Value -> Parser (JSONResponse a)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JSONResponse" forall {a}. FromJSON a => Object -> Parser (JSONResponse a)
objectParser
    where
      objectParser :: Object -> Parser (JSONResponse a)
objectParser Object
o =
        forall a. Maybe a -> [GQLError] -> JSONResponse a
JSONResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"errors" forall a. Parser (Maybe a) -> a -> Parser a
.!= []

data JSONResponse a = JSONResponse
  { forall a. JSONResponse a -> Maybe a
responseData :: Maybe a,
    forall a. JSONResponse a -> [GQLError]
responseErrors :: [GQLError]
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (JSONResponse a) x -> JSONResponse a
forall a x. JSONResponse a -> Rep (JSONResponse a) x
$cto :: forall a x. Rep (JSONResponse a) x -> JSONResponse a
$cfrom :: forall a x. JSONResponse a -> Rep (JSONResponse a) x
Generic, Int -> JSONResponse a -> ShowS
forall a. Show a => Int -> JSONResponse a -> ShowS
forall a. Show a => [JSONResponse a] -> ShowS
forall a. Show a => JSONResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONResponse a] -> ShowS
$cshowList :: forall a. Show a => [JSONResponse a] -> ShowS
show :: JSONResponse a -> String
$cshow :: forall a. Show a => JSONResponse a -> String
showsPrec :: Int -> JSONResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> JSONResponse a -> ShowS
Show, forall a. ToJSON a => [JSONResponse a] -> Encoding
forall a. ToJSON a => [JSONResponse a] -> Value
forall a. ToJSON a => JSONResponse a -> Encoding
forall a. ToJSON a => JSONResponse a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JSONResponse a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [JSONResponse a] -> Encoding
toJSONList :: [JSONResponse a] -> Value
$ctoJSONList :: forall a. ToJSON a => [JSONResponse a] -> Value
toEncoding :: JSONResponse a -> Encoding
$ctoEncoding :: forall a. ToJSON a => JSONResponse a -> Encoding
toJSON :: JSONResponse a -> Value
$ctoJSON :: forall a. ToJSON a => JSONResponse a -> Value
ToJSON)