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

module Data.Morpheus.Server.Deriving.Encode
  ( deriveModel,
    EncodeConstraints,
  )
where

-- MORPHEUS

import Control.Applicative (Applicative (..))
import Control.Monad (Monad ((>>=)))
import Data.Functor (fmap)
import Data.Functor.Identity (Identity (..))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Map (Map)
import qualified Data.Map as M
  ( toList,
  )
import Data.Maybe
  ( Maybe (..),
    maybe,
  )
import Data.Morpheus.Kind
  ( ENUM,
    GQL_KIND,
    INTERFACE,
    OUTPUT,
    SCALAR,
  )
import Data.Morpheus.Server.Deriving.Channels
  ( ChannelsConstraint,
    channelResolver,
  )
import Data.Morpheus.Server.Deriving.Decode
  ( DecodeConstraint,
    decodeArguments,
  )
import Data.Morpheus.Server.Deriving.Utils
  ( ConsRep (..),
    DataType (..),
    FieldRep (..),
    TypeConstraint (..),
    TypeRep (..),
    isUnionRef,
    toValue,
  )
import Data.Morpheus.Server.Types.GQLType (GQLType (..))
import Data.Morpheus.Server.Types.Types
  ( MapKind,
    Pair (..),
    mapKindFromList,
  )
import Data.Morpheus.Types
  ( RootResolver (..),
  )
import Data.Morpheus.Types.GQLScalar (GQLScalar (..))
import Data.Morpheus.Types.Internal.AST
  ( InternalError,
    MUTATION,
    OperationType,
    QUERY,
    SUBSCRIPTION,
    TypeRef (..),
  )
import Data.Morpheus.Types.Internal.Resolving
  ( FieldResModel,
    LiftOperation,
    ResModel (..),
    Resolver,
    ResolverState,
    RootResModel (..),
    SubscriptionField (..),
    failure,
    getArguments,
    liftResolverState,
    mkObject,
  )
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import qualified Data.Set as S
  ( toList,
  )
import Data.Traversable (traverse)
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import GHC.Generics
  ( Generic (..),
  )
import Prelude
  ( ($),
    (.),
    otherwise,
  )

newtype ContextValue (kind :: GQL_KIND) a = ContextValue
  { ContextValue kind a -> a
unContextValue :: a
  }

class Encode o e (m :: * -> *) resolver where
  encode :: resolver -> Resolver o e m (ResModel o e m)

instance {-# OVERLAPPABLE #-} (EncodeKind (KIND a) a o e m, LiftOperation o) => Encode o e m a where
  encode :: a -> Resolver o e m (ResModel o e m)
encode a
resolver = ContextValue (KIND a) a -> Resolver o e m (ResModel o e m)
forall (kind :: GQL_KIND) a (o :: OperationType) e (m :: * -> *).
(EncodeKind kind a o e m, LiftOperation o) =>
ContextValue kind a -> Resolver o e m (ResModel o e m)
encodeKind (a -> ContextValue (KIND a) a
forall (kind :: GQL_KIND) a. a -> ContextValue kind a
ContextValue a
resolver :: ContextValue (KIND a) a)

-- MAYBE
instance (Monad m, LiftOperation o, Encode o e m a) => Encode o e m (Maybe a) where
  encode :: Maybe a -> Resolver o e m (ResModel o e m)
encode = Resolver o e m (ResModel o e m)
-> (a -> Resolver o e m (ResModel o e m))
-> Maybe a
-> Resolver o e m (ResModel o e m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ResModel o e m -> Resolver o e m (ResModel o e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResModel o e m
forall (o :: OperationType) e (m :: * -> *). ResModel o e m
ResNull) a -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode

-- LIST []
instance (Monad m, Encode o e m a, LiftOperation o) => Encode o e m [a] where
  encode :: [a] -> Resolver o e m (ResModel o e m)
encode = ([ResModel o e m] -> ResModel o e m)
-> Resolver o e m [ResModel o e m]
-> Resolver o e m (ResModel o e m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ResModel o e m] -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
[ResModel o e m] -> ResModel o e m
ResList (Resolver o e m [ResModel o e m]
 -> Resolver o e m (ResModel o e m))
-> ([a] -> Resolver o e m [ResModel o e m])
-> [a]
-> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Resolver o e m (ResModel o e m))
-> [a] -> Resolver o e m [ResModel o e m]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode

--  Tuple  (a,b)
instance Encode o e m (Pair k v) => Encode o e m (k, v) where
  encode :: (k, v) -> Resolver o e m (ResModel o e m)
encode (k
key, v
value) = Pair k v -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode (k -> v -> Pair k v
forall k v. k -> v -> Pair k v
Pair k
key v
value)

--  NonEmpty
instance Encode o e m [a] => Encode o e m (NonEmpty a) where
  encode :: NonEmpty a -> Resolver o e m (ResModel o e m)
encode = [a] -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode ([a] -> Resolver o e m (ResModel o e m))
-> (NonEmpty a -> [a])
-> NonEmpty a
-> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList

--  Vector
instance Encode o e m [a] => Encode o e m (Vector a) where
  encode :: Vector a -> Resolver o e m (ResModel o e m)
encode = [a] -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode ([a] -> Resolver o e m (ResModel o e m))
-> (Vector a -> [a]) -> Vector a -> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
Vector.toList

--  Set
instance Encode o e m [a] => Encode o e m (Set a) where
  encode :: Set a -> Resolver o e m (ResModel o e m)
encode = [a] -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode ([a] -> Resolver o e m (ResModel o e m))
-> (Set a -> [a]) -> Set a -> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList

--  Map
instance (Monad m, LiftOperation o, Encode o e m (MapKind k v (Resolver o e m))) => Encode o e m (Map k v) where
  encode :: Map k v -> Resolver o e m (ResModel o e m)
encode Map k v
value =
    MapKind k v (Resolver o e m) -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode (([(k, v)] -> MapKind k v (Resolver o e m)
forall (m :: * -> *) k v.
Applicative m =>
[(k, v)] -> MapKind k v m
mapKindFromList ([(k, v)] -> MapKind k v (Resolver o e m))
-> [(k, v)] -> MapKind k v (Resolver o e m)
forall a b. (a -> b) -> a -> b
$ Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
M.toList Map k v
value) :: MapKind k v (Resolver o e m))

-- SUBSCRIPTION
instance (Monad m, LiftOperation o, Encode o e m a) => Encode o e m (SubscriptionField a) where
  encode :: SubscriptionField a -> Resolver o e m (ResModel o e m)
encode (SubscriptionField forall e (m :: * -> *) v.
(a ~ Resolver SUBSCRIPTION e m v) =>
Channel e
_ a
res) = a -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode a
res

--  GQL a -> Resolver b, MUTATION, SUBSCRIPTION, QUERY
instance
  ( DecodeConstraint a,
    Generic a,
    Monad m,
    LiftOperation o,
    Encode o e m b
  ) =>
  Encode o e m (a -> b)
  where
  encode :: (a -> b) -> Resolver o e m (ResModel o e m)
encode a -> b
f =
    Resolver o e m (Arguments VALID)
forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
Resolver o e m (Arguments VALID)
getArguments
      Resolver o e m (Arguments VALID)
-> (Arguments VALID -> Resolver o e m a) -> Resolver o e m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ResolverState a -> Resolver o e m a
forall (o :: OperationType) (m :: * -> *) a e.
(LiftOperation o, Monad m) =>
ResolverState a -> Resolver o e m a
liftResolverState (ResolverState a -> Resolver o e m a)
-> (Arguments VALID -> ResolverState a)
-> Arguments VALID
-> Resolver o e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments VALID -> ResolverState a
forall a. DecodeConstraint a => Arguments VALID -> ResolverState a
decodeArguments
      Resolver o e m a
-> (a -> Resolver o e m (ResModel o e m))
-> Resolver o e m (ResModel o e m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode (b -> Resolver o e m (ResModel o e m))
-> (a -> b) -> a -> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

--  GQL a -> Resolver b, MUTATION, SUBSCRIPTION, QUERY
instance (Monad m, Encode o e m b, LiftOperation o) => Encode o e m (Resolver o e m b) where
  encode :: Resolver o e m b -> Resolver o e m (ResModel o e m)
encode Resolver o e m b
x = Resolver o e m b
x Resolver o e m b
-> (b -> Resolver o e m (ResModel o e m))
-> Resolver o e m (ResModel o e m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode

-- ENCODE GQL KIND
class EncodeKind (kind :: GQL_KIND) a o e (m :: * -> *) where
  encodeKind :: LiftOperation o => ContextValue kind a -> Resolver o e m (ResModel o e m)

-- SCALAR
instance (GQLScalar a, Monad m) => EncodeKind SCALAR a o e m where
  encodeKind :: ContextValue SCALAR a -> Resolver o e m (ResModel o e m)
encodeKind = ResModel o e m -> Resolver o e m (ResModel o e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel o e m -> Resolver o e m (ResModel o e m))
-> (ContextValue SCALAR a -> ResModel o e m)
-> ContextValue SCALAR a
-> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarValue -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
ScalarValue -> ResModel o e m
ResScalar (ScalarValue -> ResModel o e m)
-> (ContextValue SCALAR a -> ScalarValue)
-> ContextValue SCALAR a
-> ResModel o e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ScalarValue
forall a. GQLScalar a => a -> ScalarValue
serialize (a -> ScalarValue)
-> (ContextValue SCALAR a -> a)
-> ContextValue SCALAR a
-> ScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextValue SCALAR a -> a
forall (kind :: GQL_KIND) a. ContextValue kind a -> a
unContextValue

-- ENUM
instance EncodeConstraint o e m a => EncodeKind ENUM a o e m where
  encodeKind :: ContextValue ENUM a -> Resolver o e m (ResModel o e m)
encodeKind = ResModel o e m -> Resolver o e m (ResModel o e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel o e m -> Resolver o e m (ResModel o e m))
-> (ContextValue ENUM a -> ResModel o e m)
-> ContextValue ENUM a
-> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *) a.
(EncodeConstraint o e m a, LiftOperation o) =>
a -> ResModel o e m
exploreResolvers (a -> ResModel o e m)
-> (ContextValue ENUM a -> a)
-> ContextValue ENUM a
-> ResModel o e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextValue ENUM a -> a
forall (kind :: GQL_KIND) a. ContextValue kind a -> a
unContextValue

instance EncodeConstraint o e m a => EncodeKind OUTPUT a o e m where
  encodeKind :: ContextValue OUTPUT a -> Resolver o e m (ResModel o e m)
encodeKind = ResModel o e m -> Resolver o e m (ResModel o e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel o e m -> Resolver o e m (ResModel o e m))
-> (ContextValue OUTPUT a -> ResModel o e m)
-> ContextValue OUTPUT a
-> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *) a.
(EncodeConstraint o e m a, LiftOperation o) =>
a -> ResModel o e m
exploreResolvers (a -> ResModel o e m)
-> (ContextValue OUTPUT a -> a)
-> ContextValue OUTPUT a
-> ResModel o e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextValue OUTPUT a -> a
forall (kind :: GQL_KIND) a. ContextValue kind a -> a
unContextValue

instance EncodeConstraint o e m a => EncodeKind INTERFACE a o e m where
  encodeKind :: ContextValue INTERFACE a -> Resolver o e m (ResModel o e m)
encodeKind = ResModel o e m -> Resolver o e m (ResModel o e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel o e m -> Resolver o e m (ResModel o e m))
-> (ContextValue INTERFACE a -> ResModel o e m)
-> ContextValue INTERFACE a
-> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *) a.
(EncodeConstraint o e m a, LiftOperation o) =>
a -> ResModel o e m
exploreResolvers (a -> ResModel o e m)
-> (ContextValue INTERFACE a -> a)
-> ContextValue INTERFACE a
-> ResModel o e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextValue INTERFACE a -> a
forall (kind :: GQL_KIND) a. ContextValue kind a -> a
unContextValue

convertNode ::
  (Monad m, LiftOperation o) =>
  DataType (Resolver o e m (ResModel o e m)) ->
  ResModel o e m
convertNode :: DataType (Resolver o e m (ResModel o e m)) -> ResModel o e m
convertNode
  DataType
    { TypeName
tyName :: forall v. DataType v -> TypeName
tyName :: TypeName
tyName,
      Bool
tyIsUnion :: forall v. DataType v -> Bool
tyIsUnion :: Bool
tyIsUnion,
      tyCons :: forall v. DataType v -> ConsRep v
tyCons = cons :: ConsRep (Resolver o e m (ResModel o e m))
cons@ConsRep {[FieldRep (Resolver o e m (ResModel o e m))]
consFields :: forall v. ConsRep v -> [FieldRep v]
consFields :: [FieldRep (Resolver o e m (ResModel o e m))]
consFields, TypeName
consName :: forall v. ConsRep v -> TypeName
consName :: TypeName
consName}
    }
    | Bool
tyIsUnion = [FieldRep (Resolver o e m (ResModel o e m))] -> ResModel o e m
encodeUnion [FieldRep (Resolver o e m (ResModel o e m))]
consFields
    | Bool
otherwise = TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject TypeName
tyName ((FieldRep (Resolver o e m (ResModel o e m))
 -> (FieldName, Resolver o e m (ResModel o e m)))
-> [FieldRep (Resolver o e m (ResModel o e m))]
-> [(FieldName, Resolver o e m (ResModel o e m))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldRep (Resolver o e m (ResModel o e m))
-> (FieldName, Resolver o e m (ResModel o e m))
forall (o :: OperationType) e (m :: * -> *).
FieldRep (Resolver o e m (ResModel o e m)) -> FieldResModel o e m
toFieldRes [FieldRep (Resolver o e m (ResModel o e m))]
consFields)
    where
      -- ENUM
      encodeUnion :: [FieldRep (Resolver o e m (ResModel o e m))] -> ResModel o e m
encodeUnion [] = TypeName -> TypeName -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
TypeName -> TypeName -> ResModel o e m
ResEnum TypeName
tyName TypeName
consName
      -- Type References --------------------------------------------------------------
      encodeUnion [FieldRep {fieldTypeRef :: forall a. FieldRep a -> TypeRef
fieldTypeRef = TypeRef {TypeName
typeConName :: TypeRef -> TypeName
typeConName :: TypeName
typeConName}, Resolver o e m (ResModel o e m)
fieldValue :: forall a. FieldRep a -> a
fieldValue :: Resolver o e m (ResModel o e m)
fieldValue}]
        | TypeName -> ConsRep (Resolver o e m (ResModel o e m)) -> Bool
forall k. TypeName -> ConsRep k -> Bool
isUnionRef TypeName
tyName ConsRep (Resolver o e m (ResModel o e m))
cons = TypeName -> Resolver o e m (ResModel o e m) -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
TypeName -> Resolver o e m (ResModel o e m) -> ResModel o e m
ResUnion TypeName
typeConName Resolver o e m (ResModel o e m)
fieldValue
      -- Inline Union Types ----------------------------------------------------------------------------
      encodeUnion [FieldRep (Resolver o e m (ResModel o e m))]
fields =
        TypeName -> Resolver o e m (ResModel o e m) -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
TypeName -> Resolver o e m (ResModel o e m) -> ResModel o e m
ResUnion
          TypeName
consName
          (Resolver o e m (ResModel o e m) -> ResModel o e m)
-> Resolver o e m (ResModel o e m) -> ResModel o e m
forall a b. (a -> b) -> a -> b
$ ResModel o e m -> Resolver o e m (ResModel o e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (ResModel o e m -> Resolver o e m (ResModel o e m))
-> ResModel o e m -> Resolver o e m (ResModel o e m)
forall a b. (a -> b) -> a -> b
$ TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject
            TypeName
consName
            ((FieldRep (Resolver o e m (ResModel o e m))
 -> (FieldName, Resolver o e m (ResModel o e m)))
-> [FieldRep (Resolver o e m (ResModel o e m))]
-> [(FieldName, Resolver o e m (ResModel o e m))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldRep (Resolver o e m (ResModel o e m))
-> (FieldName, Resolver o e m (ResModel o e m))
forall (o :: OperationType) e (m :: * -> *).
FieldRep (Resolver o e m (ResModel o e m)) -> FieldResModel o e m
toFieldRes [FieldRep (Resolver o e m (ResModel o e m))]
fields)

-- Types & Constrains -------------------------------------------------------
exploreResolvers ::
  forall o e m a.
  ( EncodeConstraint o e m a,
    LiftOperation o
  ) =>
  a ->
  ResModel o e m
exploreResolvers :: a -> ResModel o e m
exploreResolvers =
  DataType (Resolver o e m (ResModel o e m)) -> ResModel o e m
forall (m :: * -> *) (o :: OperationType) e.
(Monad m, LiftOperation o) =>
DataType (Resolver o e m (ResModel o e m)) -> ResModel o e m
convertNode
    (DataType (Resolver o e m (ResModel o e m)) -> ResModel o e m)
-> (a -> DataType (Resolver o e m (ResModel o e m)))
-> a
-> ResModel o e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeConstraint
  (Encode o e m) (Resolver o e m (ResModel o e m)) Identity
-> a -> DataType (Resolver o e m (ResModel o e m))
forall (constraint :: * -> Constraint) value a.
(GQLType a, Generic a, TypeRep constraint value (Rep a)) =>
TypeConstraint constraint value Identity -> a -> DataType value
toValue
      ( (forall a.
 Encode o e m a =>
 Identity a -> Resolver o e m (ResModel o e m))
-> TypeConstraint
     (Encode o e m) (Resolver o e m (ResModel o e m)) Identity
forall (c :: * -> Constraint) v (f :: * -> *).
(forall a. c a => f a -> v) -> TypeConstraint c v f
TypeConstraint (a -> Resolver o e m (ResModel o e m)
forall (o :: OperationType) e (m :: * -> *) resolver.
Encode o e m resolver =>
resolver -> Resolver o e m (ResModel o e m)
encode (a -> Resolver o e m (ResModel o e m))
-> (Identity a -> a)
-> Identity a
-> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity) ::
          TypeConstraint (Encode o e m) (Resolver o e m (ResModel o e m)) Identity
      )

----- HELPERS ----------------------------
objectResolvers ::
  ( EncodeConstraint o e m a,
    LiftOperation o
  ) =>
  a ->
  ResolverState (ResModel o e m)
objectResolvers :: a -> ResolverState (ResModel o e m)
objectResolvers a
value = ResModel o e m -> ResolverState (ResModel o e m)
forall (f :: * -> *) (o :: OperationType) e (m :: * -> *).
Failure InternalError f =>
ResModel o e m -> f (ResModel o e m)
constraintObject (a -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *) a.
(EncodeConstraint o e m a, LiftOperation o) =>
a -> ResModel o e m
exploreResolvers a
value)
  where
    constraintObject :: ResModel o e m -> f (ResModel o e m)
constraintObject obj :: ResModel o e m
obj@ResObject {} =
      ResModel o e m -> f (ResModel o e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResModel o e m
obj
    constraintObject ResModel o e m
_ =
      InternalError -> f (ResModel o e m)
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (InternalError
"resolver must be an object" :: InternalError)

type EncodeObjectConstraint (o :: OperationType) e (m :: * -> *) a =
  EncodeConstraint o e m (a (Resolver o e m))

type EncodeConstraint (o :: OperationType) e (m :: * -> *) a =
  ( Monad m,
    GQLType a,
    Generic a,
    TypeRep (Encode o e m) (Resolver o e m (ResModel o e m)) (Rep a)
  )

type EncodeConstraints e m query mut sub =
  ( ChannelsConstraint e m sub,
    EncodeObjectConstraint QUERY e m query,
    EncodeObjectConstraint MUTATION e m mut,
    EncodeObjectConstraint SUBSCRIPTION e m sub
  )

toFieldRes :: FieldRep (Resolver o e m (ResModel o e m)) -> FieldResModel o e m
toFieldRes :: FieldRep (Resolver o e m (ResModel o e m)) -> FieldResModel o e m
toFieldRes FieldRep {FieldName
fieldSelector :: forall a. FieldRep a -> FieldName
fieldSelector :: FieldName
fieldSelector, Resolver o e m (ResModel o e m)
fieldValue :: Resolver o e m (ResModel o e m)
fieldValue :: forall a. FieldRep a -> a
fieldValue} = (FieldName
fieldSelector, Resolver o e m (ResModel o e m)
fieldValue)

deriveModel ::
  forall e m query mut sub.
  (Monad m, EncodeConstraints e m query mut sub) =>
  RootResolver m e query mut sub ->
  RootResModel e m
deriveModel :: RootResolver m e query mut sub -> RootResModel e m
deriveModel
  RootResolver
    { query (Resolver QUERY e m)
queryResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (sub :: (* -> *) -> *).
RootResolver m event query mut sub
-> query (Resolver QUERY event m)
queryResolver :: query (Resolver QUERY e m)
queryResolver,
      mut (Resolver MUTATION e m)
mutationResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (sub :: (* -> *) -> *).
RootResolver m event query mut sub
-> mut (Resolver MUTATION event m)
mutationResolver :: mut (Resolver MUTATION e m)
mutationResolver,
      sub (Resolver SUBSCRIPTION e m)
subscriptionResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (sub :: (* -> *) -> *).
RootResolver m event query mut sub
-> sub (Resolver SUBSCRIPTION event m)
subscriptionResolver :: sub (Resolver SUBSCRIPTION e m)
subscriptionResolver
    } =
    RootResModel :: forall e (m :: * -> *).
ResolverState (ResModel QUERY e m)
-> ResolverState (ResModel MUTATION e m)
-> ResolverState (ResModel SUBSCRIPTION e m)
-> Maybe (Selection VALID -> ResolverState (Channel e))
-> RootResModel e m
RootResModel
      { query :: ResolverState (ResModel QUERY e m)
query = query (Resolver QUERY e m) -> ResolverState (ResModel QUERY e m)
forall (o :: OperationType) e (m :: * -> *) a.
(EncodeConstraint o e m a, LiftOperation o) =>
a -> ResolverState (ResModel o e m)
objectResolvers query (Resolver QUERY e m)
queryResolver,
        mutation :: ResolverState (ResModel MUTATION e m)
mutation = mut (Resolver MUTATION e m)
-> ResolverState (ResModel MUTATION e m)
forall (o :: OperationType) e (m :: * -> *) a.
(EncodeConstraint o e m a, LiftOperation o) =>
a -> ResolverState (ResModel o e m)
objectResolvers mut (Resolver MUTATION e m)
mutationResolver,
        subscription :: ResolverState (ResModel SUBSCRIPTION e m)
subscription = sub (Resolver SUBSCRIPTION e m)
-> ResolverState (ResModel SUBSCRIPTION e m)
forall (o :: OperationType) e (m :: * -> *) a.
(EncodeConstraint o e m a, LiftOperation o) =>
a -> ResolverState (ResModel o e m)
objectResolvers sub (Resolver SUBSCRIPTION e m)
subscriptionResolver,
        Maybe (Selection VALID -> ResolverState (Channel e))
channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
channelMap
      }
    where
      channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
channelMap
        | Proxy (sub (Resolver SUBSCRIPTION e m)) -> Bool
forall a (f :: * -> *). GQLType a => f a -> Bool
isEmptyType (Proxy (sub (Resolver SUBSCRIPTION e m))
forall k (t :: k). Proxy t
Proxy :: Proxy (sub (Resolver SUBSCRIPTION e m))) = Maybe (Selection VALID -> ResolverState (Channel e))
forall a. Maybe a
Nothing
        | Bool
otherwise = (Selection VALID -> ResolverState (Channel e))
-> Maybe (Selection VALID -> ResolverState (Channel e))
forall a. a -> Maybe a
Just (sub (Resolver SUBSCRIPTION e m)
-> Selection VALID -> ResolverState (Channel e)
forall e (m :: * -> *) (subs :: (* -> *) -> *).
ChannelsConstraint e m subs =>
subs (Resolver SUBSCRIPTION e m)
-> Selection VALID -> ResolverState (Channel e)
channelResolver sub (Resolver SUBSCRIPTION e m)
subscriptionResolver)