{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Internal.Resolve.Explore
  ( useExploreResolvers,
    useObjectResolvers,
    EXPLORE,
  )
where

import Control.Monad.Except (MonadError)
import Data.Morpheus.App.Internal.Resolving
  ( ObjectTypeResolver (..),
    ResolverState,
    ResolverValue (..),
    mkEnum,
    mkObject,
    mkUnion,
    requireObject,
  )
import Data.Morpheus.Server.Deriving.Internal.Schema.Directive
  ( toFieldRes,
    visitEnumName,
  )
import Data.Morpheus.Server.Deriving.Utils.GRep
  ( ConsRep (..),
    FieldRep (..),
    GRep,
    RepContext (..),
    TypeRep (..),
    deriveValue,
    isUnionRef,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded (inputType)
import Data.Morpheus.Server.Deriving.Utils.Use
  ( UseDeriving (..),
    UseGQLType (..),
    UseResolver (..),
  )
import Data.Morpheus.Types.Internal.AST
  ( GQLError,
    TypeRef (..),
  )
import GHC.Generics (Generic (Rep))
import Relude

convertNode ::
  gql a =>
  (MonadError GQLError m) =>
  UseDeriving gql val ->
  f a ->
  TypeRep (m (ResolverValue m)) ->
  ResolverValue m
convertNode :: forall (gql :: * -> Constraint) a (m :: * -> *)
       (val :: * -> Constraint) (f :: * -> *).
(gql a, MonadError GQLError m) =>
UseDeriving gql val
-> f a -> TypeRep (m (ResolverValue m)) -> ResolverValue m
convertNode
  UseDeriving gql val
drv
  f a
proxy
  TypeRep
    { TypeName
dataTypeName :: forall v. TypeRep v -> TypeName
dataTypeName :: TypeName
dataTypeName,
      Bool
tyIsUnion :: forall v. TypeRep v -> Bool
tyIsUnion :: Bool
tyIsUnion,
      tyCons :: forall v. TypeRep v -> ConsRep v
tyCons = cons :: ConsRep (m (ResolverValue m))
cons@ConsRep {[FieldRep (m (ResolverValue m))]
consFields :: forall v. ConsRep v -> [FieldRep v]
consFields :: [FieldRep (m (ResolverValue m))]
consFields, TypeName
consName :: forall v. ConsRep v -> TypeName
consName :: TypeName
consName}
    } = forall (m :: * -> *).
MonadError GQLError m =>
[FieldRep (m (ResolverValue m))] -> ResolverValue m
encodeTypeFields [FieldRep (m (ResolverValue m))]
consFields
    where
      -- ENUM
      encodeTypeFields :: (MonadError GQLError m) => [FieldRep (m (ResolverValue m))] -> ResolverValue m
      encodeTypeFields :: forall (m :: * -> *).
MonadError GQLError m =>
[FieldRep (m (ResolverValue m))] -> ResolverValue m
encodeTypeFields [] = forall (m :: * -> *). TypeName -> ResolverValue m
mkEnum (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> TypeName -> TypeName
visitEnumName UseDeriving gql val
drv f a
proxy TypeName
consName)
      encodeTypeFields [FieldRep (m (ResolverValue m))]
fields
        | Bool -> Bool
not Bool
tyIsUnion = forall (m :: * -> *).
TypeName -> [ResolverEntry m] -> ResolverValue m
mkObject TypeName
dataTypeName (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *) v.
gql a =>
UseDeriving gql args -> f a -> FieldRep v -> (FieldName, v)
toFieldRes UseDeriving gql val
drv f a
proxy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldRep (m (ResolverValue m))]
fields)
      -- Type References --------------------------------------------------------------
      encodeTypeFields [FieldRep {TypeRef
fieldTypeRef :: forall a. FieldRep a -> TypeRef
fieldTypeRef :: TypeRef
fieldTypeRef, m (ResolverValue m)
fieldValue :: forall a. FieldRep a -> a
fieldValue :: m (ResolverValue m)
fieldValue}]
        | forall k. TypeName -> ConsRep k -> Bool
isUnionRef TypeName
dataTypeName ConsRep (m (ResolverValue m))
cons = forall (m :: * -> *). m (ResolverValue m) -> ResolverValue m
ResLazy (forall (m :: * -> *).
Maybe TypeName -> ObjectTypeResolver m -> ResolverValue m
ResObject (forall a. a -> Maybe a
Just (TypeRef -> TypeName
typeConName TypeRef
fieldTypeRef)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m (ResolverValue m)
fieldValue forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) (m :: * -> *).
MonadError GQLError f =>
ResolverValue m -> f (ObjectTypeResolver m)
requireObject))
      -- Inline Union Types ----------------------------------------------------------------------------
      encodeTypeFields [FieldRep (m (ResolverValue m))]
fields = forall (m :: * -> *).
Monad m =>
TypeName -> [ResolverEntry m] -> ResolverValue m
mkUnion TypeName
consName (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *) v.
gql a =>
UseDeriving gql args -> f a -> FieldRep v -> (FieldName, v)
toFieldRes UseDeriving gql val
drv f a
proxy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldRep (m (ResolverValue m))]
fields)

toOptions :: UseResolver res gql val -> RepContext gql (res m) Identity (m (ResolverValue m))
toOptions :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint) (m :: * -> *).
UseResolver res gql val
-> RepContext gql (res m) Identity (m (ResolverValue m))
toOptions UseResolver {UseDeriving gql val
forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
resDrv :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val -> UseDeriving gql val
useEncodeResolver :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
resDrv :: UseDeriving gql val
useEncodeResolver :: forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
..} =
  RepContext
    { optApply :: forall a. res m a => Identity a -> m (ResolverValue m)
optApply = forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity,
      optTypeData :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeData
optTypeData = forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeData
useTypeData (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql val
resDrv) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType
    }

useExploreResolvers ::
  (MonadError GQLError m, EXPLORE gql res m a) =>
  UseResolver res gql val ->
  a ->
  ResolverValue m
useExploreResolvers :: forall (m :: * -> *) (gql :: * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers UseResolver res gql val
res a
v = forall (gql :: * -> Constraint) a (m :: * -> *)
       (val :: * -> Constraint) (f :: * -> *).
(gql a, MonadError GQLError m) =>
UseDeriving gql val
-> f a -> TypeRep (m (ResolverValue m)) -> ResolverValue m
convertNode (forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val -> UseDeriving gql val
resDrv UseResolver res gql val
res) Identity a
proxy (forall a (gql :: * -> Constraint) (constraint :: * -> Constraint)
       value.
(Generic a, GRep gql constraint value (Rep a), gql a) =>
RepContext gql constraint Identity value -> a -> TypeRep value
deriveValue (forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint) (m :: * -> *).
UseResolver res gql val
-> RepContext gql (res m) Identity (m (ResolverValue m))
toOptions UseResolver res gql val
res) a
v)
  where
    proxy :: Identity a
proxy = forall a. a -> Identity a
Identity a
v

useObjectResolvers ::
  (MonadError GQLError m, EXPLORE gql res m a) =>
  UseResolver res gql val ->
  a ->
  ResolverState (ObjectTypeResolver m)
useObjectResolvers :: forall (m :: * -> *) (gql :: * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val
-> a -> ResolverState (ObjectTypeResolver m)
useObjectResolvers UseResolver res gql val
ctx a
value = forall (f :: * -> *) (m :: * -> *).
MonadError GQLError f =>
ResolverValue m -> f (ObjectTypeResolver m)
requireObject (forall (m :: * -> *) (gql :: * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers UseResolver res gql val
ctx a
value)

type EXPLORE gql res (m :: Type -> Type) a =
  ( Generic a,
    GRep gql (res m) (m (ResolverValue m)) (Rep a),
    gql a
  )