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

module Data.Morpheus.Client.CodeGen.Interpreting.Global
  ( toGlobalDefinitions,
  )
where

import Data.Morpheus.Client.CodeGen.AST
  ( ClientDeclaration,
    ClientPreDeclaration (..),
    ClientTypeDefinition (..),
    DERIVING_MODE (..),
  )
import Data.Morpheus.Client.CodeGen.Interpreting.Core (printClientType)
import Data.Morpheus.Client.CodeGen.Interpreting.PreDeclarations
  ( mapPreDeclarations,
  )
import Data.Morpheus.CodeGen.Internal.AST
  ( CodeGenConstructor (..),
    CodeGenField (..),
    CodeGenTypeName (..),
    FIELD_TYPE_WRAPPER (..),
    fromTypeName,
  )
import Data.Morpheus.CodeGen.Utils (Flag (FlagLanguageExtension), Flags)
import Data.Morpheus.Internal.Ext (GQLResult)
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    DataEnumValue (DataEnumValue, enumName),
    FieldDefinition (..),
    Schema (Schema, types),
    TRUE,
    TypeContent (..),
    TypeDefinition (..),
    TypeKind (..),
    TypeName,
    TypeRef (..),
    VALID,
    isNotSystemTypeName,
    isNullable,
    isResolverType,
  )
import Relude hiding (empty)

toClientDeclarations :: ClientTypeDefinition -> [ClientPreDeclaration]
toClientDeclarations :: ClientTypeDefinition -> [ClientPreDeclaration]
toClientDeclarations def :: ClientTypeDefinition
def@ClientTypeDefinition {TypeKind
clientKind :: TypeKind
clientKind :: ClientTypeDefinition -> TypeKind
clientKind}
  | TypeKind
KIND_SCALAR TypeKind -> TypeKind -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind
clientKind = [DERIVING_MODE -> CodeGenType -> ClientPreDeclaration
FromJSONClass DERIVING_MODE
SCALAR_MODE CodeGenType
cgType, DERIVING_MODE -> CodeGenType -> ClientPreDeclaration
ToJSONClass DERIVING_MODE
SCALAR_MODE CodeGenType
cgType]
  | TypeKind
KIND_ENUM TypeKind -> TypeKind -> Bool
forall a. Eq a => a -> a -> Bool
== TypeKind
clientKind = [CodeGenType -> ClientPreDeclaration
ClientType CodeGenType
cgType, DERIVING_MODE -> CodeGenType -> ClientPreDeclaration
FromJSONClass DERIVING_MODE
ENUM_MODE CodeGenType
cgType, DERIVING_MODE -> CodeGenType -> ClientPreDeclaration
ToJSONClass DERIVING_MODE
ENUM_MODE CodeGenType
cgType]
  | Bool
otherwise = [CodeGenType -> ClientPreDeclaration
ClientType CodeGenType
cgType, DERIVING_MODE -> CodeGenType -> ClientPreDeclaration
ToJSONClass DERIVING_MODE
TYPE_MODE CodeGenType
cgType]
  where
    cgType :: CodeGenType
cgType = ClientTypeDefinition -> CodeGenType
printClientType ClientTypeDefinition
def

toGlobalDefinitions :: (TypeName -> Bool) -> Schema VALID -> GQLResult ([ClientDeclaration], Flags)
toGlobalDefinitions :: (TypeName -> Bool)
-> Schema VALID -> GQLResult ([ClientDeclaration], Flags)
toGlobalDefinitions TypeName -> Bool
f Schema {TypeDefinitions VALID
types :: forall (s :: Stage). Schema s -> TypeDefinitions s
types :: TypeDefinitions VALID
types} = do
  let tyDefs :: [ClientTypeDefinition]
tyDefs = (TypeDefinition ANY VALID -> Maybe ClientTypeDefinition)
-> [TypeDefinition ANY VALID] -> [ClientTypeDefinition]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TypeDefinition ANY VALID -> Maybe ClientTypeDefinition
generateGlobalType ([TypeDefinition ANY VALID] -> [ClientTypeDefinition])
-> [TypeDefinition ANY VALID] -> [ClientTypeDefinition]
forall a b. (a -> b) -> a -> b
$ (TypeDefinition ANY VALID -> Bool)
-> [TypeDefinition ANY VALID] -> [TypeDefinition ANY VALID]
forall a. (a -> Bool) -> [a] -> [a]
filter TypeDefinition ANY VALID -> Bool
shouldInclude ((TypeDefinition ANY VALID -> TypeName)
-> [TypeDefinition ANY VALID] -> [TypeDefinition ANY VALID]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName ([TypeDefinition ANY VALID] -> [TypeDefinition ANY VALID])
-> [TypeDefinition ANY VALID] -> [TypeDefinition ANY VALID]
forall a b. (a -> b) -> a -> b
$ TypeDefinitions VALID -> [TypeDefinition ANY VALID]
forall a. SafeHashMap TypeName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList TypeDefinitions VALID
types)
  [ClientDeclaration]
decs <- (ClientPreDeclaration -> Result GQLError ClientDeclaration)
-> [ClientPreDeclaration] -> Result GQLError [ClientDeclaration]
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 ClientPreDeclaration -> Result GQLError ClientDeclaration
forall (m :: * -> *).
MonadFail m =>
ClientPreDeclaration -> m ClientDeclaration
mapPreDeclarations ([ClientPreDeclaration] -> Result GQLError [ClientDeclaration])
-> [ClientPreDeclaration] -> Result GQLError [ClientDeclaration]
forall a b. (a -> b) -> a -> b
$ (ClientTypeDefinition -> [ClientPreDeclaration])
-> [ClientTypeDefinition] -> [ClientPreDeclaration]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ClientTypeDefinition -> [ClientPreDeclaration]
toClientDeclarations [ClientTypeDefinition]
tyDefs
  let hasEnums :: Bool
hasEnums = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ClientTypeDefinition] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClientTypeDefinition
x | x :: ClientTypeDefinition
x@ClientTypeDefinition {clientKind :: ClientTypeDefinition -> TypeKind
clientKind = TypeKind
KIND_ENUM} <- [ClientTypeDefinition]
tyDefs]
  ([ClientDeclaration], Flags)
-> GQLResult ([ClientDeclaration], Flags)
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ClientDeclaration]
decs, [Text -> Flag
FlagLanguageExtension Text
"LambdaCase" | Bool
hasEnums])
  where
    shouldInclude :: TypeDefinition ANY VALID -> Bool
shouldInclude TypeDefinition ANY VALID
t =
      Bool -> Bool
not (TypeDefinition ANY VALID -> Bool
forall t. Strictness t => t -> Bool
isResolverType TypeDefinition ANY VALID
t)
        Bool -> Bool -> Bool
&& TypeName -> Bool
isNotSystemTypeName (TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY VALID
t)
        Bool -> Bool -> Bool
&& TypeName -> Bool
f (TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY VALID
t)

generateGlobalType :: TypeDefinition ANY VALID -> Maybe ClientTypeDefinition
generateGlobalType :: TypeDefinition ANY VALID -> Maybe ClientTypeDefinition
generateGlobalType TypeDefinition {TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName :: TypeName
typeName, TypeContent TRUE ANY VALID
typeContent :: TypeContent TRUE ANY VALID
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent} = do
  (TypeKind
clientKind, [CodeGenConstructor]
clientCons) <- TypeContent TRUE ANY VALID
-> Maybe (TypeKind, [CodeGenConstructor])
genContent TypeContent TRUE ANY VALID
typeContent
  ClientTypeDefinition -> Maybe ClientTypeDefinition
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ClientTypeDefinition
      { clientTypeName :: CodeGenTypeName
clientTypeName = TypeName -> CodeGenTypeName
fromTypeName TypeName
typeName,
        TypeKind
clientKind :: TypeKind
clientKind :: TypeKind
clientKind,
        [CodeGenConstructor]
clientCons :: [CodeGenConstructor]
clientCons :: [CodeGenConstructor]
clientCons
      }
  where
    genContent :: TypeContent TRUE ANY VALID -> Maybe (TypeKind, [CodeGenConstructor])
    genContent :: TypeContent TRUE ANY VALID
-> Maybe (TypeKind, [CodeGenConstructor])
genContent (DataInputObject FieldsDefinition IN VALID
inputFields) =
      (TypeKind, [CodeGenConstructor])
-> Maybe (TypeKind, [CodeGenConstructor])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( TypeKind
KIND_INPUT_OBJECT,
          [ CodeGenConstructor
              { constructorName :: CodeGenTypeName
constructorName = TypeName -> CodeGenTypeName
fromTypeName TypeName
typeName,
                constructorFields :: [CodeGenField]
constructorFields = FieldDefinition IN VALID -> CodeGenField
forall (a :: TypeCategory) (b :: Stage).
FieldDefinition a b -> CodeGenField
toCodeGenField (FieldDefinition IN VALID -> CodeGenField)
-> [FieldDefinition IN VALID] -> [CodeGenField]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsDefinition IN VALID -> [FieldDefinition IN VALID]
forall a. OrdMap FieldName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition IN VALID
inputFields
              }
          ]
        )
    genContent (DataEnum DataEnum VALID
enumTags) = (TypeKind, [CodeGenConstructor])
-> Maybe (TypeKind, [CodeGenConstructor])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeKind
KIND_ENUM, TypeName -> DataEnumValue VALID -> CodeGenConstructor
forall (s :: Stage).
TypeName -> DataEnumValue s -> CodeGenConstructor
mkConsEnum TypeName
typeName (DataEnumValue VALID -> CodeGenConstructor)
-> DataEnum VALID -> [CodeGenConstructor]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataEnum VALID
enumTags)
    genContent DataScalar {} = (TypeKind, [CodeGenConstructor])
-> Maybe (TypeKind, [CodeGenConstructor])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeKind
KIND_SCALAR, [])
    genContent TypeContent TRUE ANY VALID
_ = Maybe (TypeKind, [CodeGenConstructor])
forall a. Maybe a
Nothing

toCodeGenField :: FieldDefinition a b -> CodeGenField
toCodeGenField :: forall (a :: TypeCategory) (b :: Stage).
FieldDefinition a b -> CodeGenField
toCodeGenField FieldDefinition {fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = field :: TypeRef
field@TypeRef {TypeName
TypeWrapper
typeConName :: TypeName
typeWrappers :: TypeWrapper
typeConName :: TypeRef -> TypeName
typeWrappers :: TypeRef -> TypeWrapper
..}, Maybe Text
Maybe (FieldContent TRUE a b)
Directives b
FieldName
fieldDescription :: Maybe Text
fieldName :: FieldName
fieldContent :: Maybe (FieldContent TRUE a b)
fieldDirectives :: Directives b
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Text
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
..} =
  CodeGenField
    { FieldName
fieldName :: FieldName
fieldName :: FieldName
fieldName,
      fieldType :: TypeName
fieldType = TypeName
typeConName,
      wrappers :: [FIELD_TYPE_WRAPPER]
wrappers = [TypeWrapper -> FIELD_TYPE_WRAPPER
GQL_WRAPPER TypeWrapper
typeWrappers],
      fieldIsNullable :: Bool
fieldIsNullable = TypeRef -> Bool
forall a. Nullable a => a -> Bool
isNullable TypeRef
field
    }

mkConsEnum :: TypeName -> DataEnumValue s -> CodeGenConstructor
mkConsEnum :: forall (s :: Stage).
TypeName -> DataEnumValue s -> CodeGenConstructor
mkConsEnum TypeName
typename DataEnumValue {TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName :: TypeName
enumName} =
  CodeGenTypeName -> [CodeGenField] -> CodeGenConstructor
CodeGenConstructor ([FieldName] -> [Text] -> TypeName -> CodeGenTypeName
CodeGenTypeName [TypeName -> FieldName
forall a b. Coercible a b => a -> b
coerce TypeName
typename] [] TypeName
enumName) []