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

module Data.Morpheus.Server.Deriving.Kinded.NamedResolverFun
  ( deriveNamedResolverFun,
    KindedNamedFunValue (..),
  )
where

import Control.Monad.Except (MonadError (..))
import Data.Aeson (ToJSON (..))
import Data.Morpheus.App.Internal.Resolving
  ( MonadResolver (..),
    NamedResolverRef (..),
    NamedResolverResult (..),
    ObjectTypeResolver (..),
    ResolverValue (..),
    getArguments,
    mkList,
    mkNull,
  )
import Data.Morpheus.Generic
  ( GRep,
    GRepFun (..),
    GRepValue (..),
    deriveValue,
  )
import Data.Morpheus.Server.Deriving.Internal.Directive
  ( UseDeriving,
    toFieldRes,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded
  ( CatType (..),
    Kinded (..),
    outputType,
  )
import Data.Morpheus.Server.Deriving.Utils.Use
  ( UseGQLType (..),
    UseNamedResolver (..),
    useDecodeArguments,
  )
import Data.Morpheus.Server.Types.Kind
  ( CUSTOM,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Server.Types.NamedResolvers
  ( NamedRef,
    NamedResolverT (..),
  )
import Data.Morpheus.Types.GQLScalar
  ( EncodeScalar (..),
  )
import Data.Morpheus.Types.Internal.AST
  ( GQLError,
    OUT,
    TypeName,
    ValidValue,
    Value (List),
    internal,
    replaceValue,
  )
import GHC.Generics
  ( Generic (..),
  )
import Relude hiding (empty)

deriveNamedResolverFun ::
  ( Generic a,
    gql [Maybe a],
    gql a,
    MonadError GQLError m,
    GRep gql (res m) (m (ResolverValue m)) (Rep a)
  ) =>
  UseNamedResolver namedRes res gql val ->
  [Maybe a] ->
  m [NamedResolverResult m]
deriveNamedResolverFun :: forall a (gql :: * -> Constraint) (m :: * -> *)
       (res :: (* -> *) -> * -> Constraint)
       (namedRes :: (* -> *) -> * -> Constraint) (val :: * -> Constraint).
(Generic a, gql [Maybe a], gql a, MonadError GQLError m,
 GRep gql (res m) (m (ResolverValue m)) (Rep a)) =>
UseNamedResolver namedRes res gql val
-> [Maybe a] -> m [NamedResolverResult m]
deriveNamedResolverFun UseNamedResolver namedRes res gql val
ctx [Maybe a]
x = (Maybe a -> m (NamedResolverResult m))
-> [Maybe a] -> m [NamedResolverResult m]
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 Maybe a -> m (NamedResolverResult m)
encodeNode [Maybe a]
x
  where
    encodeNode :: Maybe a -> m (NamedResolverResult m)
encodeNode (Just a
v) = UseDeriving gql val
-> Identity [Maybe a]
-> GRepValue (m (ResolverValue m))
-> m (NamedResolverResult m)
forall (m :: * -> *) (gql :: * -> Constraint) a
       (val :: * -> Constraint) (f :: * -> *).
(MonadError GQLError m, gql a) =>
UseDeriving gql val
-> f a
-> GRepValue (m (ResolverValue m))
-> m (NamedResolverResult m)
convertNamedNode (UseNamedResolver namedRes res gql val -> UseDeriving gql val
forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val -> UseDeriving gql val
namedDrv UseNamedResolver namedRes res gql val
ctx) ([Maybe a] -> Identity [Maybe a]
forall a. a -> Identity a
Identity [Maybe a]
x) (GRepFun gql (res m) Identity (m (ResolverValue m))
-> a -> GRepValue (m (ResolverValue m))
forall a (gql :: * -> Constraint) (constraint :: * -> Constraint)
       value.
(Generic a, GRep gql constraint value (Rep a), gql a) =>
GRepFun gql constraint Identity value -> a -> GRepValue value
deriveValue (UseNamedResolver namedRes res gql val
-> GRepFun gql (res m) Identity (m (ResolverValue m))
forall (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint) (m :: * -> *).
UseNamedResolver namedRes res gql val
-> GRepFun gql (res m) Identity (m (ResolverValue m))
getOptions UseNamedResolver namedRes res gql val
ctx) a
v)
    encodeNode Maybe a
Nothing = NamedResolverResult m -> m (NamedResolverResult m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamedResolverResult m
forall (m :: * -> *). NamedResolverResult m
NamedNullResolver

class KindedNamedFunValue ctx (k :: DerivingKind) (m :: Type -> Type) (a :: Type) where
  kindedNamedFunValue :: (UseNamedResolver namedRes res gql val ~ ctx) => ctx -> Kinded k a -> m (ResolverValue m)

instance (EncodeScalar a, Monad m) => KindedNamedFunValue ctx SCALAR m a where
  kindedNamedFunValue :: forall (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
(UseNamedResolver namedRes res gql val ~ ctx) =>
ctx -> Kinded SCALAR a -> m (ResolverValue m)
kindedNamedFunValue ctx
_ = ResolverValue m -> m (ResolverValue m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverValue m -> m (ResolverValue m))
-> (Kinded SCALAR a -> ResolverValue m)
-> Kinded SCALAR a
-> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarValue -> ResolverValue m
forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (ScalarValue -> ResolverValue m)
-> (Kinded SCALAR a -> ScalarValue)
-> Kinded SCALAR a
-> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ScalarValue
forall a. EncodeScalar a => a -> ScalarValue
encodeScalar (a -> ScalarValue)
-> (Kinded SCALAR a -> a) -> Kinded SCALAR a -> ScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded SCALAR a -> a
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind

instance (MonadError GQLError m) => KindedNamedFunValue ctx TYPE m a where
  kindedNamedFunValue :: forall (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
(UseNamedResolver namedRes res gql val ~ ctx) =>
ctx -> Kinded TYPE a -> m (ResolverValue m)
kindedNamedFunValue ctx
_ Kinded TYPE a
_ = GQLError -> m (ResolverValue m)
forall a. GQLError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"types are resolved by Refs")

instance (UseNamedResolver namedRes res gql val ~ ctx, Applicative m, res m a) => KindedNamedFunValue ctx WRAPPER m [a] where
  kindedNamedFunValue :: forall (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
(UseNamedResolver namedRes res gql val ~ ctx) =>
ctx -> Kinded WRAPPER [a] -> m (ResolverValue m)
kindedNamedFunValue ctx
ctx = ([ResolverValue m] -> ResolverValue m)
-> m [ResolverValue m] -> m (ResolverValue m)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ResolverValue m] -> ResolverValue m
forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
ResList (m [ResolverValue m] -> m (ResolverValue m))
-> (Kinded WRAPPER [a] -> m [ResolverValue m])
-> Kinded WRAPPER [a]
-> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (ResolverValue m)) -> [a] -> m [ResolverValue m]
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 (UseNamedResolver namedRes res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall a (m :: * -> *). fun m a => a -> m (ResolverValue m)
useNamedFieldResolver ctx
UseNamedResolver namedRes res gql val
ctx) ([a] -> m [ResolverValue m])
-> (Kinded WRAPPER [a] -> [a])
-> Kinded WRAPPER [a]
-> m [ResolverValue m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded WRAPPER [a] -> [a]
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind

instance (UseNamedResolver namedRes res gql val ~ ctx, gql a, res m a, Applicative m) => KindedNamedFunValue ctx WRAPPER m (Maybe a) where
  kindedNamedFunValue :: forall (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
(UseNamedResolver namedRes res gql val ~ ctx) =>
ctx -> Kinded WRAPPER (Maybe a) -> m (ResolverValue m)
kindedNamedFunValue ctx
ctx (Kinded (Just a
x)) = UseNamedResolver namedRes res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall a (m :: * -> *). fun m a => a -> m (ResolverValue m)
useNamedFieldResolver ctx
UseNamedResolver namedRes res gql val
ctx a
x
  kindedNamedFunValue ctx
_ (Kinded Maybe a
Nothing) = ResolverValue m -> m (ResolverValue m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResolverValue m
forall (m :: * -> *). ResolverValue m
mkNull

instance (UseNamedResolver namedRes res gql val ~ ctx, Monad m, gql a, ToJSON (NamedRef a)) => KindedNamedFunValue ctx CUSTOM m (NamedResolverT m a) where
  kindedNamedFunValue :: forall (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
(UseNamedResolver namedRes res gql val ~ ctx) =>
ctx -> Kinded CUSTOM (NamedResolverT m a) -> m (ResolverValue m)
kindedNamedFunValue ctx
ctx = Monad m => NamedResolverT m a -> m (ResolverValue m)
NamedResolverT m a -> m (ResolverValue m)
encodeRef (NamedResolverT m a -> m (ResolverValue m))
-> (Kinded CUSTOM (NamedResolverT m a) -> NamedResolverT m a)
-> Kinded CUSTOM (NamedResolverT m a)
-> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded CUSTOM (NamedResolverT m a) -> NamedResolverT m a
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind
    where
      name :: TypeName
      name :: TypeName
name = ctx -> CatType OUT a -> TypeName
forall a (c :: TypeCategory).
gql a =>
ctx -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename ctx
ctx (CatType OUT a
forall {k} (a :: k). CatType OUT a
OutputType :: CatType OUT a)
      encodeRef :: (Monad m) => NamedResolverT m a -> m (ResolverValue m)
      encodeRef :: Monad m => NamedResolverT m a -> m (ResolverValue m)
encodeRef (NamedResolverT m (NamedRef a)
ref) = do
        Value VALID
value <- Value -> Value VALID
forall (a :: Stage). Value -> Value a
replaceValue (Value -> Value VALID)
-> (NamedRef a -> Value) -> NamedRef a -> Value VALID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedRef a -> Value
forall a. ToJSON a => a -> Value
toJSON (NamedRef a -> Value VALID) -> m (NamedRef a) -> m (Value VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (NamedRef a)
ref
        case Value VALID
value of
          (List [Value VALID]
ls) -> ResolverValue m -> m (ResolverValue m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverValue m -> m (ResolverValue m))
-> ResolverValue m -> m (ResolverValue m)
forall a b. (a -> b) -> a -> b
$ [ResolverValue m] -> ResolverValue m
forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
mkList ([ResolverValue m] -> ResolverValue m)
-> [ResolverValue m] -> ResolverValue m
forall a b. (a -> b) -> a -> b
$ (Value VALID -> ResolverValue m)
-> [Value VALID] -> [ResolverValue m]
forall a b. (a -> b) -> [a] -> [b]
map (TypeName -> Value VALID -> ResolverValue m
forall (m :: * -> *).
Applicative m =>
TypeName -> Value VALID -> ResolverValue m
packRef TypeName
name) [Value VALID]
ls
          Value VALID
_ -> ResolverValue m -> m (ResolverValue m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverValue m -> m (ResolverValue m))
-> ResolverValue m -> m (ResolverValue m)
forall a b. (a -> b) -> a -> b
$ TypeName -> Value VALID -> ResolverValue m
forall (m :: * -> *).
Applicative m =>
TypeName -> Value VALID -> ResolverValue m
packRef TypeName
name Value VALID
value

packRef :: (Applicative m) => TypeName -> ValidValue -> ResolverValue m
packRef :: forall (m :: * -> *).
Applicative m =>
TypeName -> Value VALID -> ResolverValue m
packRef TypeName
name Value VALID
v = m NamedResolverRef -> ResolverValue m
forall (m :: * -> *). m NamedResolverRef -> ResolverValue m
ResRef (m NamedResolverRef -> ResolverValue m)
-> m NamedResolverRef -> ResolverValue m
forall a b. (a -> b) -> a -> b
$ NamedResolverRef -> m NamedResolverRef
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedResolverRef -> m NamedResolverRef)
-> NamedResolverRef -> m NamedResolverRef
forall a b. (a -> b) -> a -> b
$ TypeName -> [Value VALID] -> NamedResolverRef
NamedResolverRef TypeName
name [Value VALID
v]

instance (UseNamedResolver namedRes res gql val ~ ctx, Monad m, val a, MonadResolver m, res m b) => KindedNamedFunValue ctx CUSTOM m (a -> b) where
  kindedNamedFunValue :: forall (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
(UseNamedResolver namedRes res gql val ~ ctx) =>
ctx -> Kinded CUSTOM (a -> b) -> m (ResolverValue m)
kindedNamedFunValue ctx
ctx (Kinded a -> b
f) =
    m (Arguments VALID)
forall (m :: * -> *). MonadResolver m => m (Arguments VALID)
getArguments
      m (Arguments VALID) -> (Arguments VALID -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ResolverState a -> m a
forall a. ResolverState a -> m a
forall (m :: * -> *) a. MonadResolver m => ResolverState a -> m a
liftState (ResolverState a -> m a)
-> (Arguments VALID -> ResolverState a) -> Arguments VALID -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UseDeriving gql val -> Arguments VALID -> ResolverState a
forall (val :: * -> Constraint) a (gql :: * -> Constraint).
val a =>
UseDeriving gql val -> Arguments VALID -> ResolverState a
useDecodeArguments (UseNamedResolver namedRes res gql val -> UseDeriving gql val
forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val -> UseDeriving gql val
namedDrv ctx
UseNamedResolver namedRes res gql val
ctx)
      m a -> (a -> m (ResolverValue m)) -> m (ResolverValue m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UseNamedResolver namedRes res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall a (m :: * -> *). fun m a => a -> m (ResolverValue m)
useNamedFieldResolver ctx
UseNamedResolver namedRes res gql val
ctx (b -> m (ResolverValue m)) -> (a -> b) -> a -> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

getOptions :: UseNamedResolver namedRes res gql val -> GRepFun gql (res m) Identity (m (ResolverValue m))
getOptions :: forall (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint) (m :: * -> *).
UseNamedResolver namedRes res gql val
-> GRepFun gql (res m) Identity (m (ResolverValue m))
getOptions UseNamedResolver namedRes res gql val
ctx =
  GRepFun
    { grepFun :: forall a. res m a => Identity a -> m (ResolverValue m)
grepFun = UseNamedResolver namedRes res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall a (m :: * -> *). fun m a => a -> m (ResolverValue m)
useNamedFieldResolver UseNamedResolver namedRes res gql val
ctx (a -> m (ResolverValue m))
-> (Identity a -> a) -> Identity a -> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity,
      grepTypename :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
grepTypename = UseNamedResolver namedRes res gql val -> CatType OUT a -> TypeName
forall a (c :: TypeCategory).
gql a =>
UseNamedResolver namedRes res gql val -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename UseNamedResolver namedRes res gql val
ctx (CatType OUT a -> TypeName)
-> (proxy a -> CatType OUT a) -> proxy a -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> CatType OUT a
forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType,
      grepWrappers :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
grepWrappers = UseNamedResolver namedRes res gql val
-> CatType OUT a -> TypeWrapper
forall a (c :: TypeCategory).
gql a =>
UseNamedResolver namedRes res gql val -> CatType c a -> TypeWrapper
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeWrapper
useWrappers UseNamedResolver namedRes res gql val
ctx (CatType OUT a -> TypeWrapper)
-> (proxy a -> CatType OUT a) -> proxy a -> TypeWrapper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> CatType OUT a
forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType
    }

convertNamedNode ::
  (MonadError GQLError m, gql a) =>
  UseDeriving gql val ->
  f a ->
  GRepValue (m (ResolverValue m)) ->
  m (NamedResolverResult m)
convertNamedNode :: forall (m :: * -> *) (gql :: * -> Constraint) a
       (val :: * -> Constraint) (f :: * -> *).
(MonadError GQLError m, gql a) =>
UseDeriving gql val
-> f a
-> GRepValue (m (ResolverValue m))
-> m (NamedResolverResult m)
convertNamedNode UseDeriving gql val
_ f a
_ GRepValueEnum {TypeName
enumTypeName :: TypeName
enumVariantName :: TypeName
enumTypeName :: forall v. GRepValue v -> TypeName
enumVariantName :: forall v. GRepValue v -> TypeName
..} = NamedResolverResult m -> m (NamedResolverResult m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedResolverResult m -> m (NamedResolverResult m))
-> NamedResolverResult m -> m (NamedResolverResult m)
forall a b. (a -> b) -> a -> b
$ TypeName -> NamedResolverResult m
forall (m :: * -> *). TypeName -> NamedResolverResult m
NamedEnumResolver TypeName
enumVariantName
convertNamedNode UseDeriving gql val
drv f a
proxy GRepValueObject {[GRepField (m (ResolverValue m))]
TypeName
objectTypeName :: TypeName
objectFields :: [GRepField (m (ResolverValue m))]
objectTypeName :: forall v. GRepValue v -> TypeName
objectFields :: forall v. GRepValue v -> [GRepField v]
..} = NamedResolverResult m -> m (NamedResolverResult m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedResolverResult m -> m (NamedResolverResult m))
-> NamedResolverResult m -> m (NamedResolverResult m)
forall a b. (a -> b) -> a -> b
$ ObjectTypeResolver m -> NamedResolverResult m
forall (m :: * -> *). ObjectTypeResolver m -> NamedResolverResult m
NamedObjectResolver (ObjectTypeResolver m -> NamedResolverResult m)
-> ObjectTypeResolver m -> NamedResolverResult m
forall a b. (a -> b) -> a -> b
$ HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m
forall (m :: * -> *).
HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m
ObjectTypeResolver (HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m)
-> HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m
forall a b. (a -> b) -> a -> b
$ [Item (HashMap FieldName (m (ResolverValue m)))]
-> HashMap FieldName (m (ResolverValue m))
forall l. IsList l => [Item l] -> l
fromList (UseDeriving gql val
-> f a
-> GRepField (m (ResolverValue m))
-> (FieldName, m (ResolverValue m))
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *) v.
gql a =>
UseDeriving gql args -> f a -> GRepField v -> (FieldName, v)
toFieldRes UseDeriving gql val
drv f a
proxy (GRepField (m (ResolverValue m))
 -> (FieldName, m (ResolverValue m)))
-> [GRepField (m (ResolverValue m))]
-> [(FieldName, m (ResolverValue m))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GRepField (m (ResolverValue m))]
objectFields)
convertNamedNode UseDeriving gql val
_ f a
_ GRepValueUnionRef {m (ResolverValue m)
TypeName
unionRefTypeName :: TypeName
unionRefValue :: m (ResolverValue m)
unionRefTypeName :: forall v. GRepValue v -> TypeName
unionRefValue :: forall v. GRepValue v -> v
..} = NamedResolverRef -> NamedResolverResult m
forall (m :: * -> *). NamedResolverRef -> NamedResolverResult m
NamedUnionResolver (NamedResolverRef -> NamedResolverResult m)
-> m NamedResolverRef -> m (NamedResolverResult m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m (ResolverValue m)
unionRefValue m (ResolverValue m)
-> (ResolverValue m -> m NamedResolverRef) -> m NamedResolverRef
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ResolverValue m -> m NamedResolverRef
forall (m :: * -> *).
MonadError GQLError m =>
ResolverValue m -> m NamedResolverRef
getRef)
convertNamedNode UseDeriving gql val
_ f a
_ GRepValueUnion {} = GQLError -> m (NamedResolverResult m)
forall a. GQLError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"only union references are supported!"

getRef :: (MonadError GQLError m) => ResolverValue m -> m NamedResolverRef
getRef :: forall (m :: * -> *).
MonadError GQLError m =>
ResolverValue m -> m NamedResolverRef
getRef (ResRef m NamedResolverRef
x) = m NamedResolverRef
x
getRef ResolverValue m
_ = GQLError -> m NamedResolverRef
forall a. GQLError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"only resolver references are supported!"