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

module Data.Morpheus.Client.Transform.Inputs
  ( renderNonOutputTypes,
    renderOperationArguments,
  )
where

import Data.Morpheus.Client.Internal.Types
  ( ClientConstructorDefinition (..),
    ClientTypeDefinition (..),
    TypeNameTH (..),
  )
import Data.Morpheus.Client.Internal.Utils
  ( removeDuplicates,
  )
import Data.Morpheus.Client.Transform.Core
  ( Converter (..),
    UpdateT (..),
    customScalarTypes,
    getType,
    resolveUpdates,
    typeFrom,
  )
import Data.Morpheus.Internal.Utils
  ( empty,
  )
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    DataEnumValue (DataEnumValue, enumName),
    FieldDefinition (..),
    IN,
    Operation (..),
    RAW,
    TRUE,
    TypeContent (..),
    TypeDefinition (..),
    TypeKind (..),
    TypeName,
    TypeRef (..),
    VALID,
    Variable (..),
    VariableDefinitions,
    getOperationName,
    toAny,
  )
import Relude hiding (empty)

renderArguments ::
  VariableDefinitions RAW ->
  TypeName ->
  Maybe ClientTypeDefinition
renderArguments :: VariableDefinitions RAW -> TypeName -> Maybe ClientTypeDefinition
renderArguments VariableDefinitions RAW
variables TypeName
cName
  | VariableDefinitions RAW -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null VariableDefinitions RAW
variables = Maybe ClientTypeDefinition
forall a. Maybe a
Nothing
  | Bool
otherwise = ClientTypeDefinition -> Maybe ClientTypeDefinition
forall a. a -> Maybe a
Just ClientTypeDefinition
rootArgumentsType
  where
    rootArgumentsType :: ClientTypeDefinition
    rootArgumentsType :: ClientTypeDefinition
rootArgumentsType =
      ClientTypeDefinition :: TypeNameTH
-> [ClientConstructorDefinition]
-> TypeKind
-> ClientTypeDefinition
ClientTypeDefinition
        { clientTypeName :: TypeNameTH
clientTypeName = [FieldName] -> TypeName -> TypeNameTH
TypeNameTH [] TypeName
cName,
          clientKind :: TypeKind
clientKind = TypeKind
KindInputObject,
          clientCons :: [ClientConstructorDefinition]
clientCons =
            [ ClientConstructorDefinition :: TypeName
-> [FieldDefinition ANY VALID] -> ClientConstructorDefinition
ClientConstructorDefinition
                { TypeName
cName :: TypeName
cName :: TypeName
cName,
                  cFields :: [FieldDefinition ANY VALID]
cFields = Variable RAW -> FieldDefinition ANY VALID
fieldD (Variable RAW -> FieldDefinition ANY VALID)
-> [Variable RAW] -> [FieldDefinition ANY VALID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableDefinitions RAW -> [Variable RAW]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList VariableDefinitions RAW
variables
                }
            ]
        }
      where
        fieldD :: Variable RAW -> FieldDefinition ANY VALID
        fieldD :: Variable RAW -> FieldDefinition ANY VALID
fieldD Variable {FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName :: FieldName
variableName, TypeRef
variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType :: TypeRef
variableType} =
          FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
            { fieldName :: FieldName
fieldName = FieldName
variableName,
              fieldContent :: Maybe (FieldContent TRUE ANY VALID)
fieldContent = Maybe (FieldContent TRUE ANY VALID)
forall a. Maybe a
Nothing,
              fieldType :: TypeRef
fieldType = TypeRef
variableType,
              fieldDescription :: Maybe Description
fieldDescription = Maybe Description
forall a. Maybe a
Nothing,
              fieldDirectives :: Directives VALID
fieldDirectives = Directives VALID
forall coll. Empty coll => coll
empty
            }

renderOperationArguments ::
  Operation VALID ->
  Converter (Maybe ClientTypeDefinition)
renderOperationArguments :: Operation VALID -> Converter (Maybe ClientTypeDefinition)
renderOperationArguments Operation {Maybe FieldName
operationName :: forall (s :: Stage). Operation s -> Maybe FieldName
operationName :: Maybe FieldName
operationName} =
  ((Schema VALID, VariableDefinitions RAW)
 -> Maybe ClientTypeDefinition)
-> Converter (Maybe ClientTypeDefinition)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((VariableDefinitions RAW -> TypeName -> Maybe ClientTypeDefinition
`renderArguments` (Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName TypeName -> TypeName -> TypeName
forall a. Semigroup a => a -> a -> a
<> TypeName
"Args")) (VariableDefinitions RAW -> Maybe ClientTypeDefinition)
-> ((Schema VALID, VariableDefinitions RAW)
    -> VariableDefinitions RAW)
-> (Schema VALID, VariableDefinitions RAW)
-> Maybe ClientTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema VALID, VariableDefinitions RAW) -> VariableDefinitions RAW
forall a b. (a, b) -> b
snd)

-- INPUTS
renderNonOutputTypes ::
  [TypeName] ->
  Converter [ClientTypeDefinition]
renderNonOutputTypes :: [TypeName] -> Converter [ClientTypeDefinition]
renderNonOutputTypes [TypeName]
leafTypes = do
  [Variable RAW]
variables <- ((Schema VALID, VariableDefinitions RAW) -> [Variable RAW])
-> Converter [Variable RAW]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (VariableDefinitions RAW -> [Variable RAW]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (VariableDefinitions RAW -> [Variable RAW])
-> ((Schema VALID, VariableDefinitions RAW)
    -> VariableDefinitions RAW)
-> (Schema VALID, VariableDefinitions RAW)
-> [Variable RAW]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema VALID, VariableDefinitions RAW) -> VariableDefinitions RAW
forall a b. (a, b) -> b
snd)
  [TypeName]
inputTypeRequests <- [TypeName]
-> [UpdateT Converter [TypeName]] -> Converter [TypeName]
forall (m :: * -> *) a. Monad m => a -> [UpdateT m a] -> m a
resolveUpdates [] ([UpdateT Converter [TypeName]] -> Converter [TypeName])
-> [UpdateT Converter [TypeName]] -> Converter [TypeName]
forall a b. (a -> b) -> a -> b
$ (Variable RAW -> UpdateT Converter [TypeName])
-> [Variable RAW] -> [UpdateT Converter [TypeName]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TypeName] -> Converter [TypeName])
-> UpdateT Converter [TypeName]
forall (m :: * -> *) a. (a -> m a) -> UpdateT m a
UpdateT (([TypeName] -> Converter [TypeName])
 -> UpdateT Converter [TypeName])
-> (Variable RAW -> [TypeName] -> Converter [TypeName])
-> Variable RAW
-> UpdateT Converter [TypeName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> [TypeName] -> Converter [TypeName]
exploreInputTypeNames (TypeName -> [TypeName] -> Converter [TypeName])
-> (Variable RAW -> TypeName)
-> Variable RAW
-> [TypeName]
-> Converter [TypeName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> TypeName
typeConName (TypeRef -> TypeName)
-> (Variable RAW -> TypeRef) -> Variable RAW -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable RAW -> TypeRef
forall (stage :: Stage). Variable stage -> TypeRef
variableType) [Variable RAW]
variables
  [[ClientTypeDefinition]] -> [ClientTypeDefinition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ClientTypeDefinition]] -> [ClientTypeDefinition])
-> Converter [[ClientTypeDefinition]]
-> Converter [ClientTypeDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeName -> Converter [ClientTypeDefinition])
-> [TypeName] -> Converter [[ClientTypeDefinition]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeName -> Converter [ClientTypeDefinition]
buildInputType ([TypeName] -> [TypeName]
forall a. Eq a => [a] -> [a]
removeDuplicates ([TypeName] -> [TypeName]) -> [TypeName] -> [TypeName]
forall a b. (a -> b) -> a -> b
$ [TypeName]
inputTypeRequests [TypeName] -> [TypeName] -> [TypeName]
forall a. Semigroup a => a -> a -> a
<> [TypeName]
leafTypes)

exploreInputTypeNames :: TypeName -> [TypeName] -> Converter [TypeName]
exploreInputTypeNames :: TypeName -> [TypeName] -> Converter [TypeName]
exploreInputTypeNames TypeName
name [TypeName]
collected
  | TypeName
name TypeName -> [TypeName] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [TypeName]
collected = [TypeName] -> Converter [TypeName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeName]
collected
  | Bool
otherwise = TypeName -> Converter (TypeDefinition ANY VALID)
getType TypeName
name Converter (TypeDefinition ANY VALID)
-> (TypeDefinition ANY VALID -> Converter [TypeName])
-> Converter [TypeName]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeDefinition ANY VALID -> Converter [TypeName]
scanInpType
  where
    scanInpType :: TypeDefinition ANY VALID -> Converter [TypeName]
scanInpType TypeDefinition {TypeContent TRUE ANY VALID
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE ANY VALID
typeContent, TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName :: TypeName
typeName} = TypeContent TRUE ANY VALID -> Converter [TypeName]
scanType TypeContent TRUE ANY VALID
typeContent
      where
        scanType :: TypeContent TRUE ANY VALID -> Converter [TypeName]
scanType (DataInputObject FieldsDefinition IN VALID
fields) =
          [TypeName]
-> [UpdateT Converter [TypeName]] -> Converter [TypeName]
forall (m :: * -> *) a. Monad m => a -> [UpdateT m a] -> m a
resolveUpdates
            (TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
collected)
            (FieldDefinition IN VALID -> UpdateT Converter [TypeName]
toInputTypeD (FieldDefinition IN VALID -> UpdateT Converter [TypeName])
-> [FieldDefinition IN VALID] -> [UpdateT Converter [TypeName]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsDefinition IN VALID -> [FieldDefinition IN VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition IN VALID
fields)
          where
            toInputTypeD :: FieldDefinition IN VALID -> UpdateT Converter [TypeName]
            toInputTypeD :: FieldDefinition IN VALID -> UpdateT Converter [TypeName]
toInputTypeD FieldDefinition {fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = TypeRef {TypeName
typeConName :: TypeName
typeConName :: TypeRef -> TypeName
typeConName}} =
              ([TypeName] -> Converter [TypeName])
-> UpdateT Converter [TypeName]
forall (m :: * -> *) a. (a -> m a) -> UpdateT m a
UpdateT (TypeName -> [TypeName] -> Converter [TypeName]
exploreInputTypeNames TypeName
typeConName)
        scanType (DataEnum DataEnum VALID
_) = [TypeName] -> Converter [TypeName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TypeName]
collected [TypeName] -> [TypeName] -> [TypeName]
forall a. Semigroup a => a -> a -> a
<> [TypeName
typeName])
        scanType (DataScalar ScalarDefinition
_) = [TypeName] -> Converter [TypeName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TypeName]
collected [TypeName] -> [TypeName] -> [TypeName]
forall a. Semigroup a => a -> a -> a
<> TypeName -> [TypeName]
customScalarTypes TypeName
typeName)
        scanType TypeContent TRUE ANY VALID
_ = [TypeName] -> Converter [TypeName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeName]
collected

buildInputType ::
  TypeName ->
  Converter [ClientTypeDefinition]
buildInputType :: TypeName -> Converter [ClientTypeDefinition]
buildInputType TypeName
name = TypeName -> Converter (TypeDefinition ANY VALID)
getType TypeName
name Converter (TypeDefinition ANY VALID)
-> (TypeDefinition ANY VALID -> Converter [ClientTypeDefinition])
-> Converter [ClientTypeDefinition]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeDefinition ANY VALID -> Converter [ClientTypeDefinition]
generateTypes
  where
    generateTypes :: TypeDefinition ANY VALID -> Converter [ClientTypeDefinition]
generateTypes TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> 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} = TypeContent TRUE ANY VALID -> Converter [ClientTypeDefinition]
subTypes TypeContent TRUE ANY VALID
typeContent
      where
        subTypes :: TypeContent TRUE ANY VALID -> Converter [ClientTypeDefinition]
        subTypes :: TypeContent TRUE ANY VALID -> Converter [ClientTypeDefinition]
subTypes (DataInputObject FieldsDefinition IN VALID
inputFields) = do
          [FieldDefinition IN VALID]
fields <- (FieldDefinition IN VALID -> Converter (FieldDefinition IN VALID))
-> [FieldDefinition IN VALID]
-> Converter [FieldDefinition IN VALID]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition IN VALID -> Converter (FieldDefinition IN VALID)
toClientFieldDefinition (FieldsDefinition IN VALID -> [FieldDefinition IN VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition IN VALID
inputFields)
          [ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            [ TypeName
-> TypeKind
-> [ClientConstructorDefinition]
-> ClientTypeDefinition
mkInputType
                TypeName
typeName
                TypeKind
KindInputObject
                [ ClientConstructorDefinition :: TypeName
-> [FieldDefinition ANY VALID] -> ClientConstructorDefinition
ClientConstructorDefinition
                    { cName :: TypeName
cName = TypeName
typeName,
                      cFields :: [FieldDefinition ANY VALID]
cFields = (FieldDefinition IN VALID -> FieldDefinition ANY VALID)
-> [FieldDefinition IN VALID] -> [FieldDefinition ANY VALID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDefinition IN VALID -> FieldDefinition ANY VALID
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny [FieldDefinition IN VALID]
fields
                    }
                ]
            ]
        subTypes (DataEnum DataEnum VALID
enumTags) =
          [ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            [ TypeName
-> TypeKind
-> [ClientConstructorDefinition]
-> ClientTypeDefinition
mkInputType
                TypeName
typeName
                TypeKind
KindEnum
                ((DataEnumValue VALID -> ClientConstructorDefinition)
-> DataEnum VALID -> [ClientConstructorDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DataEnumValue VALID -> ClientConstructorDefinition
forall (s :: Stage). DataEnumValue s -> ClientConstructorDefinition
mkConsEnum DataEnum VALID
enumTags)
            ]
        subTypes DataScalar {} =
          [ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            [ TypeName
-> TypeKind
-> [ClientConstructorDefinition]
-> ClientTypeDefinition
mkInputType
                TypeName
typeName
                TypeKind
KindScalar
                []
            ]
        subTypes TypeContent TRUE ANY VALID
_ = [ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

mkConsEnum :: DataEnumValue s -> ClientConstructorDefinition
mkConsEnum :: DataEnumValue s -> ClientConstructorDefinition
mkConsEnum DataEnumValue {TypeName
enumName :: TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName} = TypeName
-> [FieldDefinition ANY VALID] -> ClientConstructorDefinition
ClientConstructorDefinition TypeName
enumName []

mkInputType :: TypeName -> TypeKind -> [ClientConstructorDefinition] -> ClientTypeDefinition
mkInputType :: TypeName
-> TypeKind
-> [ClientConstructorDefinition]
-> ClientTypeDefinition
mkInputType TypeName
typename TypeKind
clientKind [ClientConstructorDefinition]
clientCons =
  ClientTypeDefinition :: TypeNameTH
-> [ClientConstructorDefinition]
-> TypeKind
-> ClientTypeDefinition
ClientTypeDefinition
    { clientTypeName :: TypeNameTH
clientTypeName = [FieldName] -> TypeName -> TypeNameTH
TypeNameTH [] TypeName
typename,
      TypeKind
clientKind :: TypeKind
clientKind :: TypeKind
clientKind,
      [ClientConstructorDefinition]
clientCons :: [ClientConstructorDefinition]
clientCons :: [ClientConstructorDefinition]
clientCons
    }

toClientFieldDefinition :: FieldDefinition IN VALID -> Converter (FieldDefinition IN VALID)
toClientFieldDefinition :: FieldDefinition IN VALID -> Converter (FieldDefinition IN VALID)
toClientFieldDefinition FieldDefinition {TypeRef
fieldType :: TypeRef
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType, Maybe Description
Maybe (FieldContent TRUE IN VALID)
FieldName
Directives VALID
fieldDirectives :: Directives VALID
fieldContent :: Maybe (FieldContent TRUE IN VALID)
fieldName :: FieldName
fieldDescription :: Maybe Description
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
..} = do
  TypeName
typeConName <- [FieldName] -> TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom [] (TypeDefinition ANY VALID -> TypeName)
-> Converter (TypeDefinition ANY VALID) -> Converter TypeName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeName -> Converter (TypeDefinition ANY VALID)
getType (TypeRef -> TypeName
typeConName TypeRef
fieldType)
  FieldDefinition IN VALID -> Converter (FieldDefinition IN VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition {fieldType :: TypeRef
fieldType = TypeRef
fieldType {TypeName
typeConName :: TypeName
typeConName :: TypeName
typeConName}, Maybe Description
Maybe (FieldContent TRUE IN VALID)
FieldName
Directives VALID
fieldDirectives :: Directives VALID
fieldContent :: Maybe (FieldContent TRUE IN VALID)
fieldName :: FieldName
fieldDescription :: Maybe Description
fieldDirectives :: Directives VALID
fieldDescription :: Maybe Description
fieldContent :: Maybe (FieldContent TRUE IN VALID)
fieldName :: FieldName
..}