{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.CodeGen.Interpreting.Arguments
  ( genArguments,
  )
where

import Data.Morpheus.Client.CodeGen.AST
  ( ClientPreDeclaration (..),
    DERIVING_MODE (..),
  )
import Data.Morpheus.Client.CodeGen.Interpreting.Core
  ( defaultDerivations,
  )
import Data.Morpheus.CodeGen.Internal.AST (CodeGenConstructor (..), CodeGenField (..), CodeGenType (..), FIELD_TYPE_WRAPPER (..), fromTypeName, getFullName)
import Data.Morpheus.Types.Internal.AST
  ( RAW,
    TypeName,
    TypeRef (..),
    Variable (..),
    VariableDefinitions,
    isNullable,
  )
import Relude hiding (empty, show)

genArguments :: TypeName -> VariableDefinitions RAW -> (TypeName, [ClientPreDeclaration])
genArguments :: TypeName
-> VariableDefinitions RAW -> (TypeName, [ClientPreDeclaration])
genArguments TypeName
operationTypeName VariableDefinitions RAW
variables
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null VariableDefinitions RAW
variables = (TypeName
"()", [])
  | Bool
otherwise = (CodeGenTypeName -> TypeName
getFullName CodeGenTypeName
cgTypeName, [CodeGenType -> ClientPreDeclaration
ClientType CodeGenType
def, DERIVING_MODE -> CodeGenType -> ClientPreDeclaration
ToJSONClass DERIVING_MODE
TYPE_MODE CodeGenType
def])
  where
    def :: CodeGenType
def =
      CodeGenType
        { CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName,
          cgConstructors :: [CodeGenConstructor]
cgConstructors = [CodeGenConstructor {constructorName :: CodeGenTypeName
constructorName = CodeGenTypeName
cgTypeName, constructorFields :: [CodeGenField]
constructorFields = Variable RAW -> CodeGenField
packAsCodeGenField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList VariableDefinitions RAW
variables}],
          cgDerivations :: [DerivingClass]
cgDerivations = [DerivingClass]
defaultDerivations
        }
    cgTypeName :: CodeGenTypeName
cgTypeName = TypeName -> CodeGenTypeName
fromTypeName forall a b. (a -> b) -> a -> b
$ TypeName
operationTypeName forall a. Semigroup a => a -> a -> a
<> TypeName
"Args"

packAsCodeGenField :: Variable RAW -> CodeGenField
packAsCodeGenField :: Variable RAW -> CodeGenField
packAsCodeGenField Variable {FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName :: FieldName
variableName, variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType = ref :: TypeRef
ref@TypeRef {TypeWrapper
TypeName
typeConName :: TypeRef -> TypeName
typeWrappers :: TypeRef -> TypeWrapper
typeWrappers :: TypeWrapper
typeConName :: TypeName
..}} =
  CodeGenField
    { fieldName :: FieldName
fieldName = FieldName
variableName,
      fieldType :: TypeName
fieldType = TypeName
typeConName,
      wrappers :: [FIELD_TYPE_WRAPPER]
wrappers = [TypeWrapper -> FIELD_TYPE_WRAPPER
GQL_WRAPPER TypeWrapper
typeWrappers],
      fieldIsNullable :: Bool
fieldIsNullable = forall a. Nullable a => a -> Bool
isNullable TypeRef
ref
    }