{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.CodeGen.Interpreting.PreDeclarations
  ( mapPreDeclarations,
  )
where

import Data.Aeson
  ( FromJSON (parseJSON),
    ToJSON (toJSON),
  )
import Data.Aeson.Types ((.:), (.:?), (.=))
import Data.Morpheus.Client.CodeGen.AST
  ( AesonField,
    ClientDeclaration (..),
    ClientMethod (..),
    ClientPreDeclaration (..),
    DERIVING_MODE (..),
    MValue (..),
    RequestTypeDefinition (..),
    UnionPat (..),
  )
import Data.Morpheus.Client.CodeGen.Internal (invalidConstructorError, omitNulls)
import Data.Morpheus.Client.Fetch.RequestType
  ( RequestType (..),
  )
import Data.Morpheus.CodeGen.Internal.AST
  ( AssociatedType (AssociatedTypeName),
    CodeGenConstructor (..),
    CodeGenField (..),
    CodeGenType (..),
    CodeGenTypeName (typename),
    MethodArgument (..),
    PrintableValue (..),
    TypeClassInstance (..),
    fromTypeName,
    getFullName,
  )
import Data.Morpheus.CodeGen.TH
  ( ToName (toName),
  )
import Data.Morpheus.CodeGen.Utils (camelCaseFieldName)
import Data.Morpheus.Types.GQLScalar
  ( scalarFromJSON,
    scalarToJSON,
  )
import Data.Morpheus.Types.Internal.AST (Msg (..), internal)
import Language.Haskell.TH.Syntax (Name)
import Relude hiding (ToString, Type, toString)

mapPreDeclarations :: MonadFail m => ClientPreDeclaration -> m ClientDeclaration
mapPreDeclarations :: forall (m :: * -> *).
MonadFail m =>
ClientPreDeclaration -> m ClientDeclaration
mapPreDeclarations (FromJSONClass DERIVING_MODE
mode CodeGenType
dec) = DERIVING_MODE
-> TypeClassInstance ClientMethod -> ClientDeclaration
InstanceDeclaration DERIVING_MODE
mode (TypeClassInstance ClientMethod -> ClientDeclaration)
-> m (TypeClassInstance ClientMethod) -> m ClientDeclaration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)
forall (m :: * -> *).
MonadFail m =>
DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)
deriveFromJSON DERIVING_MODE
mode CodeGenType
dec
mapPreDeclarations (FromJSONObjectClass CodeGenTypeName
cType CodeGenConstructor {[CodeGenField]
CodeGenTypeName
constructorName :: CodeGenTypeName
constructorFields :: [CodeGenField]
constructorName :: CodeGenConstructor -> CodeGenTypeName
constructorFields :: CodeGenConstructor -> [CodeGenField]
..}) =
  ClientDeclaration -> m ClientDeclaration
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientDeclaration -> m ClientDeclaration)
-> ClientDeclaration -> m ClientDeclaration
forall a b. (a -> b) -> a -> b
$ DERIVING_MODE
-> TypeClassInstance ClientMethod -> ClientDeclaration
InstanceDeclaration DERIVING_MODE
TYPE_MODE (TypeClassInstance ClientMethod -> ClientDeclaration)
-> TypeClassInstance ClientMethod -> ClientDeclaration
forall a b. (a -> b) -> a -> b
$ CodeGenTypeName -> ClientMethod -> TypeClassInstance ClientMethod
forall body. CodeGenTypeName -> body -> TypeClassInstance body
mkFromJSON CodeGenTypeName
cType (ClientMethod -> TypeClassInstance ClientMethod)
-> ClientMethod -> TypeClassInstance ClientMethod
forall a b. (a -> b) -> a -> b
$ TypeName -> [AesonField] -> ClientMethod
FromJSONObjectMethod (CodeGenTypeName -> TypeName
getFullName CodeGenTypeName
constructorName) ((CodeGenField -> AesonField) -> [CodeGenField] -> [AesonField]
forall a b. (a -> b) -> [a] -> [b]
map CodeGenField -> AesonField
defField [CodeGenField]
constructorFields)
mapPreDeclarations (FromJSONUnionClass CodeGenTypeName
cType [(UnionPat, (CodeGenTypeName, Maybe String))]
constructors) = ClientDeclaration -> m ClientDeclaration
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientDeclaration -> m ClientDeclaration)
-> ClientDeclaration -> m ClientDeclaration
forall a b. (a -> b) -> a -> b
$ DERIVING_MODE
-> TypeClassInstance ClientMethod -> ClientDeclaration
InstanceDeclaration DERIVING_MODE
TYPE_MODE (TypeClassInstance ClientMethod -> ClientDeclaration)
-> TypeClassInstance ClientMethod -> ClientDeclaration
forall a b. (a -> b) -> a -> b
$ CodeGenTypeName -> ClientMethod -> TypeClassInstance ClientMethod
forall body. CodeGenTypeName -> body -> TypeClassInstance body
mkFromJSON CodeGenTypeName
cType (ClientMethod -> TypeClassInstance ClientMethod)
-> ClientMethod -> TypeClassInstance ClientMethod
forall a b. (a -> b) -> a -> b
$ [([UnionPat], (Name, Maybe Name))] -> ClientMethod
FromJSONUnionMethod ([([UnionPat], (Name, Maybe Name))] -> ClientMethod)
-> [([UnionPat], (Name, Maybe Name))] -> ClientMethod
forall a b. (a -> b) -> a -> b
$ ((UnionPat, (CodeGenTypeName, Maybe String))
 -> ([UnionPat], (Name, Maybe Name)))
-> [(UnionPat, (CodeGenTypeName, Maybe String))]
-> [([UnionPat], (Name, Maybe Name))]
forall a b. (a -> b) -> [a] -> [b]
map (UnionPat, (CodeGenTypeName, Maybe String))
-> ([UnionPat], (Name, Maybe Name))
forall {a} {a}.
(ToName a, ToName a) =>
(UnionPat, (a, Maybe a)) -> ([UnionPat], (Name, Maybe Name))
mkMatch [(UnionPat, (CodeGenTypeName, Maybe String))]
constructors
  where
    mkMatch :: (UnionPat, (a, Maybe a)) -> ([UnionPat], (Name, Maybe Name))
mkMatch (UnionPat
tag, (a
consName, Maybe a
typeName)) = ([UnionPat
tag, String -> UnionPat
UVar (String -> UnionPat) -> String -> UnionPat
forall a b. (a -> b) -> a -> b
$ if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
typeName then String
"v" else String
"_"], (a -> Name
forall a. ToName a => a -> Name
toName a
consName, (a -> Name) -> Maybe a -> Maybe Name
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Name
forall a. ToName a => a -> Name
toName Maybe a
typeName))
mapPreDeclarations (ToJSONClass DERIVING_MODE
mode CodeGenType
clientDef) = DERIVING_MODE
-> TypeClassInstance ClientMethod -> ClientDeclaration
InstanceDeclaration DERIVING_MODE
mode (TypeClassInstance ClientMethod -> ClientDeclaration)
-> m (TypeClassInstance ClientMethod) -> m ClientDeclaration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)
forall (m :: * -> *).
MonadFail m =>
DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)
deriveToJSON DERIVING_MODE
mode CodeGenType
clientDef
mapPreDeclarations (ClientType CodeGenType
c) = ClientDeclaration -> m ClientDeclaration
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientDeclaration -> m ClientDeclaration)
-> ClientDeclaration -> m ClientDeclaration
forall a b. (a -> b) -> a -> b
$ CodeGenType -> ClientDeclaration
ClientTypeDeclaration CodeGenType
c
mapPreDeclarations (RequestTypeClass RequestTypeDefinition
req) = ClientDeclaration -> m ClientDeclaration
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientDeclaration -> m ClientDeclaration)
-> ClientDeclaration -> m ClientDeclaration
forall a b. (a -> b) -> a -> b
$ DERIVING_MODE
-> TypeClassInstance ClientMethod -> ClientDeclaration
InstanceDeclaration DERIVING_MODE
TYPE_MODE (RequestTypeDefinition -> TypeClassInstance ClientMethod
getRequestInstance RequestTypeDefinition
req)

getRequestInstance :: RequestTypeDefinition -> TypeClassInstance ClientMethod
getRequestInstance :: RequestTypeDefinition -> TypeClassInstance ClientMethod
getRequestInstance RequestTypeDefinition {String
TypeName
OperationType
requestName :: TypeName
requestArgs :: TypeName
requestType :: OperationType
requestQuery :: String
requestName :: RequestTypeDefinition -> TypeName
requestArgs :: RequestTypeDefinition -> TypeName
requestType :: RequestTypeDefinition -> OperationType
requestQuery :: RequestTypeDefinition -> String
..} =
  TypeClassInstance
    { typeClassName :: Name
typeClassName = ''RequestType,
      typeClassContext :: [(Name, Name)]
typeClassContext = [],
      typeClassTarget :: CodeGenTypeName
typeClassTarget = TypeName -> CodeGenTypeName
fromTypeName TypeName
requestName,
      assoc :: [(Name, AssociatedType)]
assoc = [(''RequestArgs, Name -> AssociatedType
AssociatedTypeName (Name -> AssociatedType) -> Name -> AssociatedType
forall a b. (a -> b) -> a -> b
$ TypeName -> Name
forall a. ToName a => a -> Name
toName TypeName
requestArgs)],
      [(Name, MethodArgument, ClientMethod)]
typeClassMethods :: [(Name, MethodArgument, ClientMethod)]
typeClassMethods :: [(Name, MethodArgument, ClientMethod)]
typeClassMethods
    }
  where
    typeClassMethods :: [(Name, MethodArgument, ClientMethod)]
typeClassMethods =
      [ ('__name, MethodArgument
ProxyArgument, PrintableValue -> ClientMethod
PrintableMethod (PrintableValue -> ClientMethod) -> PrintableValue -> ClientMethod
forall a b. (a -> b) -> a -> b
$ TypeName -> PrintableValue
forall a. (Show a, Lift a) => a -> PrintableValue
PrintableValue TypeName
requestName),
        ('__query, MethodArgument
ProxyArgument, PrintableValue -> ClientMethod
PrintableMethod (PrintableValue -> ClientMethod) -> PrintableValue -> ClientMethod
forall a b. (a -> b) -> a -> b
$ String -> PrintableValue
forall a. (Show a, Lift a) => a -> PrintableValue
PrintableValue String
requestQuery),
        ('__type, MethodArgument
ProxyArgument, PrintableValue -> ClientMethod
PrintableMethod (PrintableValue -> ClientMethod) -> PrintableValue -> ClientMethod
forall a b. (a -> b) -> a -> b
$ OperationType -> PrintableValue
forall a. (Show a, Lift a) => a -> PrintableValue
PrintableValue OperationType
requestType)
      ]

-- FromJSON
deriveFromJSONMethod :: MonadFail m => DERIVING_MODE -> CodeGenType -> m ClientMethod
deriveFromJSONMethod :: forall (m :: * -> *).
MonadFail m =>
DERIVING_MODE -> CodeGenType -> m ClientMethod
deriveFromJSONMethod DERIVING_MODE
SCALAR_MODE CodeGenType
_ = ClientMethod -> m ClientMethod
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientMethod -> m ClientMethod) -> ClientMethod -> m ClientMethod
forall a b. (a -> b) -> a -> b
$ Name -> ClientMethod
FunctionNameMethod 'scalarFromJSON
deriveFromJSONMethod DERIVING_MODE
ENUM_MODE CodeGenType {[CodeGenConstructor]
[DerivingClass]
CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgConstructors :: [CodeGenConstructor]
cgDerivations :: [DerivingClass]
cgTypeName :: CodeGenType -> CodeGenTypeName
cgConstructors :: CodeGenType -> [CodeGenConstructor]
cgDerivations :: CodeGenType -> [DerivingClass]
..} =
  ClientMethod -> m ClientMethod
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientMethod -> m ClientMethod) -> ClientMethod -> m ClientMethod
forall a b. (a -> b) -> a -> b
$
    ValueMatch -> ClientMethod
MatchMethod (ValueMatch -> ClientMethod) -> ValueMatch -> ClientMethod
forall a b. (a -> b) -> a -> b
$
      (CodeGenConstructor -> MValue)
-> [CodeGenConstructor] -> ValueMatch
forall a b. (a -> b) -> [a] -> [b]
map (CodeGenTypeName -> MValue
fromJSONEnum (CodeGenTypeName -> MValue)
-> (CodeGenConstructor -> CodeGenTypeName)
-> CodeGenConstructor
-> MValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeGenConstructor -> CodeGenTypeName
constructorName) [CodeGenConstructor]
cgConstructors
        ValueMatch -> ValueMatch -> ValueMatch
forall a. Semigroup a => a -> a -> a
<> [String -> Name -> MValue
MFunction String
"v" 'invalidConstructorError]
deriveFromJSONMethod DERIVING_MODE
_ CodeGenType {[CodeGenConstructor]
[DerivingClass]
CodeGenTypeName
cgTypeName :: CodeGenType -> CodeGenTypeName
cgConstructors :: CodeGenType -> [CodeGenConstructor]
cgDerivations :: CodeGenType -> [DerivingClass]
cgTypeName :: CodeGenTypeName
cgConstructors :: [CodeGenConstructor]
cgDerivations :: [DerivingClass]
..} = CodeGenTypeName -> m ClientMethod
forall (m :: * -> *) a. MonadFail m => CodeGenTypeName -> m a
emptyTypeError CodeGenTypeName
cgTypeName

defField :: CodeGenField -> AesonField
defField :: CodeGenField -> AesonField
defField CodeGenField {Bool
[FIELD_TYPE_WRAPPER]
TypeName
FieldName
fieldName :: FieldName
fieldType :: TypeName
wrappers :: [FIELD_TYPE_WRAPPER]
fieldIsNullable :: Bool
fieldName :: CodeGenField -> FieldName
fieldType :: CodeGenField -> TypeName
wrappers :: CodeGenField -> [FIELD_TYPE_WRAPPER]
fieldIsNullable :: CodeGenField -> Bool
..} = (String -> Name
forall a. ToName a => a -> Name
toName (String
"v" :: String), Bool -> Name
bindField Bool
fieldIsNullable, FieldName
fieldName)

bindField :: Bool -> Name
bindField :: Bool -> Name
bindField Bool
nullable
  | Bool
nullable = '(.:?)
  | Bool
otherwise = '(.:)

deriveToJSONMethod :: MonadFail m => DERIVING_MODE -> CodeGenType -> m (MethodArgument, ClientMethod)
deriveToJSONMethod :: forall (m :: * -> *).
MonadFail m =>
DERIVING_MODE -> CodeGenType -> m (MethodArgument, ClientMethod)
deriveToJSONMethod DERIVING_MODE
SCALAR_MODE CodeGenType
_ = (MethodArgument, ClientMethod) -> m (MethodArgument, ClientMethod)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MethodArgument
NoArgument, Name -> ClientMethod
FunctionNameMethod 'scalarToJSON)
deriveToJSONMethod DERIVING_MODE
_ CodeGenType {cgConstructors :: CodeGenType -> [CodeGenConstructor]
cgConstructors = [], [DerivingClass]
CodeGenTypeName
cgTypeName :: CodeGenType -> CodeGenTypeName
cgDerivations :: CodeGenType -> [DerivingClass]
cgTypeName :: CodeGenTypeName
cgDerivations :: [DerivingClass]
..} = CodeGenTypeName -> m (MethodArgument, ClientMethod)
forall (m :: * -> *) a. MonadFail m => CodeGenTypeName -> m a
emptyTypeError CodeGenTypeName
cgTypeName
deriveToJSONMethod DERIVING_MODE
ENUM_MODE CodeGenType {[CodeGenConstructor]
cgConstructors :: CodeGenType -> [CodeGenConstructor]
cgConstructors :: [CodeGenConstructor]
cgConstructors} =
  (MethodArgument, ClientMethod) -> m (MethodArgument, ClientMethod)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( MethodArgument
NoArgument,
      ValueMatch -> ClientMethod
MatchMethod (ValueMatch -> ClientMethod) -> ValueMatch -> ClientMethod
forall a b. (a -> b) -> a -> b
$ (CodeGenConstructor -> MValue)
-> [CodeGenConstructor] -> ValueMatch
forall a b. (a -> b) -> [a] -> [b]
map (CodeGenTypeName -> MValue
toJSONEnum (CodeGenTypeName -> MValue)
-> (CodeGenConstructor -> CodeGenTypeName)
-> CodeGenConstructor
-> MValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeGenConstructor -> CodeGenTypeName
constructorName) [CodeGenConstructor]
cgConstructors
    )
deriveToJSONMethod DERIVING_MODE
_ CodeGenType {cgConstructors :: CodeGenType -> [CodeGenConstructor]
cgConstructors = [CodeGenConstructor {[CodeGenField]
CodeGenTypeName
constructorName :: CodeGenConstructor -> CodeGenTypeName
constructorFields :: CodeGenConstructor -> [CodeGenField]
constructorName :: CodeGenTypeName
constructorFields :: [CodeGenField]
..}]} =
  (MethodArgument, ClientMethod) -> m (MethodArgument, ClientMethod)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Name -> [Name] -> MethodArgument
DestructArgument (CodeGenTypeName -> Name
forall a. ToName a => a -> Name
toName CodeGenTypeName
constructorName) (((FieldName, Name, Name) -> Name)
-> [(FieldName, Name, Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\(FieldName
_, Name
_, Name
v) -> Name
v) [(FieldName, Name, Name)]
entries),
      Name -> [(FieldName, Name, Name)] -> ClientMethod
ToJSONObjectMethod 'omitNulls [(FieldName, Name, Name)]
entries
    )
  where
    entries :: [(FieldName, Name, Name)]
entries = (CodeGenField -> (FieldName, Name, Name))
-> [CodeGenField] -> [(FieldName, Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map CodeGenField -> (FieldName, Name, Name)
mkEntry [CodeGenField]
constructorFields
    mkEntry :: CodeGenField -> (FieldName, Name, Name)
mkEntry CodeGenField {FieldName
fieldName :: CodeGenField -> FieldName
fieldName :: FieldName
fieldName} =
      ( FieldName
fieldName,
        '(.=),
        FieldName -> Name
forall a. ToName a => a -> Name
toName (FieldName -> Name) -> FieldName -> Name
forall a b. (a -> b) -> a -> b
$ TypeName -> FieldName -> FieldName
camelCaseFieldName (CodeGenTypeName -> TypeName
getFullName CodeGenTypeName
constructorName) FieldName
fieldName
      )
deriveToJSONMethod DERIVING_MODE
_ CodeGenType
_ = String -> m (MethodArgument, ClientMethod)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Input Unions are not yet supported"

toJSONEnum :: CodeGenTypeName -> MValue
toJSONEnum :: CodeGenTypeName -> MValue
toJSONEnum CodeGenTypeName
name = TypeName -> TypeName -> MValue
MTo (CodeGenTypeName -> TypeName
getFullName CodeGenTypeName
name) (CodeGenTypeName -> TypeName
typename CodeGenTypeName
name)

fromJSONEnum :: CodeGenTypeName -> MValue
fromJSONEnum :: CodeGenTypeName -> MValue
fromJSONEnum CodeGenTypeName
name = TypeName -> TypeName -> MValue
MFrom (CodeGenTypeName -> TypeName
typename CodeGenTypeName
name) (CodeGenTypeName -> TypeName
getFullName CodeGenTypeName
name)

deriveToJSON :: MonadFail m => DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)
deriveToJSON :: forall (m :: * -> *).
MonadFail m =>
DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)
deriveToJSON DERIVING_MODE
mode CodeGenType
cType = do
  (MethodArgument
args, ClientMethod
expr) <- DERIVING_MODE -> CodeGenType -> m (MethodArgument, ClientMethod)
forall (m :: * -> *).
MonadFail m =>
DERIVING_MODE -> CodeGenType -> m (MethodArgument, ClientMethod)
deriveToJSONMethod DERIVING_MODE
mode CodeGenType
cType
  TypeClassInstance ClientMethod
-> m (TypeClassInstance ClientMethod)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TypeClassInstance
      { typeClassName :: Name
typeClassName = ''ToJSON,
        typeClassContext :: [(Name, Name)]
typeClassContext = [],
        typeClassTarget :: CodeGenTypeName
typeClassTarget = CodeGenType -> CodeGenTypeName
cgTypeName CodeGenType
cType,
        assoc :: [(Name, AssociatedType)]
assoc = [],
        typeClassMethods :: [(Name, MethodArgument, ClientMethod)]
typeClassMethods = [('toJSON, MethodArgument
args, ClientMethod
expr)]
      }

mkFromJSON :: CodeGenTypeName -> body -> TypeClassInstance body
mkFromJSON :: forall body. CodeGenTypeName -> body -> TypeClassInstance body
mkFromJSON CodeGenTypeName
typeClassTarget body
expr =
  TypeClassInstance
    { typeClassName :: Name
typeClassName = ''FromJSON,
      typeClassContext :: [(Name, Name)]
typeClassContext = [],
      typeClassTarget :: CodeGenTypeName
typeClassTarget = CodeGenTypeName
typeClassTarget,
      assoc :: [(Name, AssociatedType)]
assoc = [],
      typeClassMethods :: [(Name, MethodArgument, body)]
typeClassMethods = [('parseJSON, MethodArgument
NoArgument, body
expr)]
    }

deriveFromJSON :: MonadFail m => DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)
deriveFromJSON :: forall (m :: * -> *).
MonadFail m =>
DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)
deriveFromJSON DERIVING_MODE
mode CodeGenType
cType = CodeGenTypeName -> ClientMethod -> TypeClassInstance ClientMethod
forall body. CodeGenTypeName -> body -> TypeClassInstance body
mkFromJSON (CodeGenType -> CodeGenTypeName
cgTypeName CodeGenType
cType) (ClientMethod -> TypeClassInstance ClientMethod)
-> m ClientMethod -> m (TypeClassInstance ClientMethod)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DERIVING_MODE -> CodeGenType -> m ClientMethod
forall (m :: * -> *).
MonadFail m =>
DERIVING_MODE -> CodeGenType -> m ClientMethod
deriveFromJSONMethod DERIVING_MODE
mode CodeGenType
cType

emptyTypeError :: MonadFail m => CodeGenTypeName -> m a
emptyTypeError :: forall (m :: * -> *) a. MonadFail m => CodeGenTypeName -> m a
emptyTypeError CodeGenTypeName
name = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ GQLError -> String
forall b a. (Show a, IsString b) => a -> b
show (GQLError -> String) -> GQLError -> String
forall a b. (a -> b) -> a -> b
$ GQLError -> GQLError
internal (GQLError
"Type " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg (CodeGenTypeName -> TypeName
getFullName CodeGenTypeName
name) GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" Should Have at least one Constructor")