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

module Data.Morpheus.Server.Deriving.Resolvers
  ( deriveResolvers,
    deriveNamedResolvers,
    DERIVE_RESOLVERS,
    DERIVE_NAMED_RESOLVERS,
  )
where

import Data.Morpheus.App.Internal.Resolving
  ( MonadResolver (MonadMutation, MonadQuery, MonadSubscription),
    NamedResolver (..),
    Resolver,
    ResolverValue,
    RootResolverValue (..),
  )
import Data.Morpheus.Generic (CBox, runCBox)
import Data.Morpheus.Generic.GScan
  ( ScanRef,
    scan,
    useProxies,
  )
import Data.Morpheus.Internal.Ext (GQLResult)
import Data.Morpheus.Server.Deriving.Internal.Resolver
  ( EXPLORE,
    useObjectResolvers,
  )
import Data.Morpheus.Server.Deriving.Kinded.Channels
  ( CHANNELS,
    resolverChannels,
  )
import Data.Morpheus.Server.Deriving.Kinded.NamedResolver
  ( KindedNamedResolver (..),
  )
import Data.Morpheus.Server.Deriving.Kinded.NamedResolverFun (KindedNamedFunValue (..))
import Data.Morpheus.Server.Deriving.Utils.Kinded (Kinded (..))
import Data.Morpheus.Server.Deriving.Utils.Use (UseNamedResolver (..))
import Data.Morpheus.Server.Resolvers
  ( NamedResolverT (..),
    NamedResolvers (..),
    RootResolver (..),
  )
import Data.Morpheus.Server.Types.GQLType
  ( GQLResolver,
    GQLType (..),
    GQLValue,
    ignoreUndefined,
    kindedProxy,
    withDir,
    withRes,
  )
import Data.Morpheus.Types.Internal.AST
  ( QUERY,
  )
import Relude

class GQLNamedResolverFun (m :: Type -> Type) a where
  deriveNamedResFun :: a -> m (ResolverValue m)

type NAMED = UseNamedResolver GQLNamedResolver GQLNamedResolverFun GQLType GQLValue

class (GQLType a) => GQLNamedResolver (m :: Type -> Type) a where
  deriveNamedRes :: f a -> [NamedResolver m]
  deriveNamedRefs :: f a -> [ScanRef Proxy (GQLNamedResolver m)]

instance (GQLType a, KindedNamedResolver NAMED (KIND a) m a) => GQLNamedResolver m a where
  deriveNamedRes :: forall (f :: * -> *). f a -> [NamedResolver m]
deriveNamedRes = NAMED -> Proxy (Any (KIND a) a) -> [NamedResolver m]
forall {k} ctx (k1 :: DerivingKind) (m :: * -> *) (a :: k) {k2}
       (namedRes :: (* -> *) -> * -> Constraint)
       (resFun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint) (p :: k2 -> *)
       (f :: DerivingKind -> k -> k2).
(KindedNamedResolver ctx k1 m a,
 UseNamedResolver namedRes resFun gql val ~ ctx) =>
ctx -> p (f k1 a) -> [NamedResolver m]
forall {k2} (namedRes :: (* -> *) -> * -> Constraint)
       (resFun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint) (p :: k2 -> *)
       (f :: DerivingKind -> * -> k2).
(UseNamedResolver namedRes resFun gql val ~ NAMED) =>
NAMED -> p (f (KIND a) a) -> [NamedResolver m]
kindedNamedResolver NAMED
withNamed (Proxy (Any (KIND a) a) -> [NamedResolver m])
-> (f a -> Proxy (Any (KIND a) a)) -> f a -> [NamedResolver m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Proxy (Any (KIND a) a)
forall (f :: * -> *) a (f' :: DerivingKind -> * -> *).
f a -> Proxy (f' (KIND a) a)
kindedProxy
  deriveNamedRefs :: forall (f :: * -> *). f a -> [ScanRef Proxy (GQLNamedResolver m)]
deriveNamedRefs = NAMED
-> Proxy (Any (KIND a) a) -> [ScanRef Proxy (GQLNamedResolver m)]
forall {k} ctx (k1 :: DerivingKind) (m :: * -> *) (a :: k) {k2}
       (namedRes :: (* -> *) -> * -> Constraint)
       (resFun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint) (p :: k2 -> *)
       (f :: DerivingKind -> k -> k2).
(KindedNamedResolver ctx k1 m a,
 UseNamedResolver namedRes resFun gql val ~ ctx) =>
ctx -> p (f k1 a) -> [ScanRef Proxy (namedRes m)]
forall {k2} (namedRes :: (* -> *) -> * -> Constraint)
       (resFun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint) (p :: k2 -> *)
       (f :: DerivingKind -> * -> k2).
(UseNamedResolver namedRes resFun gql val ~ NAMED) =>
NAMED -> p (f (KIND a) a) -> [ScanRef Proxy (namedRes m)]
kindedNamedRefs NAMED
withNamed (Proxy (Any (KIND a) a) -> [ScanRef Proxy (GQLNamedResolver m)])
-> (f a -> Proxy (Any (KIND a) a))
-> f a
-> [ScanRef Proxy (GQLNamedResolver m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Proxy (Any (KIND a) a)
forall (f :: * -> *) a (f' :: DerivingKind -> * -> *).
f a -> Proxy (f' (KIND a) a)
kindedProxy

instance (KindedNamedFunValue NAMED (KIND a) m a) => GQLNamedResolverFun m a where
  deriveNamedResFun :: a -> m (ResolverValue m)
deriveNamedResFun a
resolver = NAMED -> Kinded (KIND a) a -> m (ResolverValue m)
forall ctx (k :: DerivingKind) (m :: * -> *) a
       (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
(KindedNamedFunValue ctx k m a,
 UseNamedResolver namedRes res gql val ~ ctx) =>
ctx -> Kinded k a -> m (ResolverValue m)
forall (namedRes :: (* -> *) -> * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
(UseNamedResolver namedRes res gql val ~ NAMED) =>
NAMED -> Kinded (KIND a) a -> m (ResolverValue m)
kindedNamedFunValue NAMED
withNamed (a -> Kinded (KIND a) a
forall (kind :: DerivingKind) a. a -> Kinded kind a
Kinded a
resolver :: Kinded (KIND a) a)

withNamed :: NAMED
withNamed :: NAMED
withNamed =
  UseNamedResolver
    { namedDrv :: UseDeriving GQLType GQLValue
namedDrv = UseDeriving GQLType GQLValue
withDir,
      useNamedFieldResolver :: forall a (m :: * -> *).
GQLNamedResolverFun m a =>
a -> m (ResolverValue m)
useNamedFieldResolver = a -> m (ResolverValue m)
forall a (m :: * -> *).
GQLNamedResolverFun m a =>
a -> m (ResolverValue m)
forall (m :: * -> *) a.
GQLNamedResolverFun m a =>
a -> m (ResolverValue m)
deriveNamedResFun,
      useDeriveNamedResolvers :: forall (f :: * -> *) a (m :: * -> *).
GQLNamedResolver m a =>
f a -> [NamedResolver m]
useDeriveNamedResolvers = f a -> [NamedResolver m]
forall (f :: * -> *). f a -> [NamedResolver m]
forall (m :: * -> *) a (f :: * -> *).
GQLNamedResolver m a =>
f a -> [NamedResolver m]
forall (f :: * -> *) a (m :: * -> *).
GQLNamedResolver m a =>
f a -> [NamedResolver m]
deriveNamedRes,
      useDeriveNamedRefs :: forall (f :: * -> *) a (m :: * -> *).
GQLNamedResolver m a =>
f a -> [ScanRef Proxy (GQLNamedResolver m)]
useDeriveNamedRefs = f a -> [ScanRef Proxy (GQLNamedResolver m)]
forall (f :: * -> *). f a -> [ScanRef Proxy (GQLNamedResolver m)]
forall (m :: * -> *) a (f :: * -> *).
GQLNamedResolver m a =>
f a -> [ScanRef Proxy (GQLNamedResolver m)]
forall (f :: * -> *) a (m :: * -> *).
GQLNamedResolver m a =>
f a -> [ScanRef Proxy (GQLNamedResolver m)]
deriveNamedRefs
    }

type ROOT (m :: Type -> Type) a = EXPLORE GQLType GQLResolver m (a m)

type DERIVE_RESOLVERS m query mut sub =
  ( CHANNELS GQLType GQLValue sub (MonadSubscription m),
    ROOT (MonadQuery m) query,
    ROOT (MonadMutation m) mut,
    ROOT (MonadSubscription m) sub
  )

type DERIVE_NAMED_RESOLVERS m query =
  ( GQLType (query (NamedResolverT m)),
    KindedNamedResolver NAMED (KIND (query (NamedResolverT m))) m (query (NamedResolverT m))
  )

deriveResolvers ::
  (Monad m, DERIVE_RESOLVERS (Resolver QUERY e m) query mut sub) =>
  RootResolver m e query mut sub ->
  GQLResult (RootResolverValue e m)
deriveResolvers :: forall (m :: * -> *) e (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (sub :: (* -> *) -> *).
(Monad m, DERIVE_RESOLVERS (Resolver QUERY e m) query mut sub) =>
RootResolver m e query mut sub -> GQLResult (RootResolverValue e m)
deriveResolvers RootResolver {query (Resolver QUERY e m)
mut (Resolver MUTATION e m)
sub (Resolver SUBSCRIPTION e m)
queryResolver :: query (Resolver QUERY e m)
mutationResolver :: mut (Resolver MUTATION e m)
subscriptionResolver :: sub (Resolver SUBSCRIPTION e m)
queryResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *)
       (mutation :: (* -> *) -> *) (subscription :: (* -> *) -> *).
RootResolver m event query mutation subscription
-> query (Resolver QUERY event m)
mutationResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *)
       (mutation :: (* -> *) -> *) (subscription :: (* -> *) -> *).
RootResolver m event query mutation subscription
-> mutation (Resolver MUTATION event m)
subscriptionResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *)
       (mutation :: (* -> *) -> *) (subscription :: (* -> *) -> *).
RootResolver m event query mutation subscription
-> subscription (Resolver SUBSCRIPTION event m)
..} =
  RootResolverValue e m -> Result GQLError (RootResolverValue e m)
forall a. a -> Result GQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    RootResolverValue
      { queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver = UseResolver GQLResolver GQLType GQLValue
-> query (Resolver QUERY e m)
-> ResolverState (ObjectTypeResolver (Resolver QUERY e m))
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 GQLResolver GQLType GQLValue
withRes query (Resolver QUERY e m)
queryResolver,
        mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver = UseResolver GQLResolver GQLType GQLValue
-> mut (Resolver MUTATION e m)
-> ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
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 GQLResolver GQLType GQLValue
withRes mut (Resolver MUTATION e m)
mutationResolver,
        subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver = UseResolver GQLResolver GQLType GQLValue
-> sub (Resolver SUBSCRIPTION e m)
-> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
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 GQLResolver GQLType GQLValue
withRes sub (Resolver SUBSCRIPTION e m)
subscriptionResolver,
        channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
channelMap =
          Identity (sub (Resolver SUBSCRIPTION e m))
-> Maybe (Identity (sub (Resolver SUBSCRIPTION e m)))
forall (f :: * -> *) a. GQLType a => f a -> Maybe (f a)
ignoreUndefined (sub (Resolver SUBSCRIPTION e m)
-> Identity (sub (Resolver SUBSCRIPTION e m))
forall a. a -> Identity a
Identity sub (Resolver SUBSCRIPTION e m)
subscriptionResolver)
            Maybe (Identity (sub (Resolver SUBSCRIPTION e m)))
-> (Selection VALID -> ResolverState (Channel e))
-> Maybe (Selection VALID -> ResolverState (Channel e))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> UseDeriving GQLType GQLValue
-> sub (Resolver SUBSCRIPTION e m)
-> Selection VALID
-> ResolverState (Channel (MonadEvent (Resolver SUBSCRIPTION e m)))
forall (m :: * -> *) (subs :: (* -> *) -> *)
       (gql :: * -> Constraint) (val :: * -> Constraint).
CHANNELS gql val subs m =>
UseDeriving gql val
-> subs m
-> Selection VALID
-> ResolverState (Channel (MonadEvent m))
resolverChannels UseDeriving GQLType GQLValue
withDir sub (Resolver SUBSCRIPTION e m)
subscriptionResolver
      }

runProxy :: CBox Proxy (GQLNamedResolver m) -> [NamedResolver m]
runProxy :: forall (m :: * -> *).
CBox Proxy (GQLNamedResolver m) -> [NamedResolver m]
runProxy = (forall a. GQLNamedResolver m a => Proxy a -> [NamedResolver m])
-> CBox Proxy (GQLNamedResolver m) -> [NamedResolver m]
forall {k} (c :: k -> Constraint) (f :: k -> *) b.
(forall (a :: k). c a => f a -> b) -> CBox f c -> b
runCBox Proxy a -> [NamedResolver m]
forall a. GQLNamedResolver m a => Proxy a -> [NamedResolver m]
forall (f :: * -> *). f a -> [NamedResolver m]
forall (m :: * -> *) a (f :: * -> *).
GQLNamedResolver m a =>
f a -> [NamedResolver m]
deriveNamedRes

queryProxy :: NamedResolvers m e query mut sub -> Proxy (query (NamedResolverT (Resolver QUERY e m)))
queryProxy :: forall (m :: * -> *) e (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (sub :: (* -> *) -> *).
NamedResolvers m e query mut sub
-> Proxy (query (NamedResolverT (Resolver QUERY e m)))
queryProxy NamedResolvers m e query mut sub
_ = Proxy (query (NamedResolverT (Resolver QUERY e m)))
forall {k} (t :: k). Proxy t
Proxy

deriveNamedResolvers ::
  (Monad m, DERIVE_NAMED_RESOLVERS (Resolver QUERY e m) query) =>
  NamedResolvers m e query mut sub ->
  RootResolverValue e m
deriveNamedResolvers :: forall (m :: * -> *) e (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (sub :: (* -> *) -> *).
(Monad m, DERIVE_NAMED_RESOLVERS (Resolver QUERY e m) query) =>
NamedResolvers m e query mut sub -> RootResolverValue e m
deriveNamedResolvers =
  ResolverMap (Resolver QUERY e m) -> RootResolverValue e m
forall e (m :: * -> *).
ResolverMap (Resolver QUERY e m) -> RootResolverValue e m
NamedResolversValue
    (ResolverMap (Resolver QUERY e m) -> RootResolverValue e m)
-> (NamedResolvers m e query mut sub
    -> ResolverMap (Resolver QUERY e m))
-> NamedResolvers m e query mut sub
-> RootResolverValue e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CBox Proxy (GQLNamedResolver (Resolver QUERY e m))
 -> [NamedResolver (Resolver QUERY e m)])
-> (NamedResolver (Resolver QUERY e m) -> TypeName)
-> [CBox Proxy (GQLNamedResolver (Resolver QUERY e m))]
-> ResolverMap (Resolver QUERY e m)
forall {k1} k2 (f :: k1 -> *) (c :: k1 -> Constraint) v.
(Hashable k2, Eq k2) =>
(CBox f c -> [v]) -> (v -> k2) -> [CBox f c] -> HashMap k2 v
useProxies CBox Proxy (GQLNamedResolver (Resolver QUERY e m))
-> [NamedResolver (Resolver QUERY e m)]
forall (m :: * -> *).
CBox Proxy (GQLNamedResolver m) -> [NamedResolver m]
runProxy NamedResolver (Resolver QUERY e m) -> TypeName
forall (m :: * -> *). NamedResolver m -> TypeName
resolverName
    ([CBox Proxy (GQLNamedResolver (Resolver QUERY e m))]
 -> ResolverMap (Resolver QUERY e m))
-> (NamedResolvers m e query mut sub
    -> [CBox Proxy (GQLNamedResolver (Resolver QUERY e m))])
-> NamedResolvers m e query mut sub
-> ResolverMap (Resolver QUERY e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a'.
 GQLNamedResolver (Resolver QUERY e m) a' =>
 Proxy a'
 -> [ScanRef Proxy (GQLNamedResolver (Resolver QUERY e m))])
-> Proxy (query (NamedResolverT (Resolver QUERY e m)))
-> [CBox Proxy (GQLNamedResolver (Resolver QUERY e m))]
forall (c :: * -> Constraint) a (f :: * -> *).
(c a, ProxyMap f) =>
(forall a'. c a' => f a' -> [ScanRef f c]) -> f a -> [CBox f c]
scan Proxy a' -> [ScanRef Proxy (GQLNamedResolver (Resolver QUERY e m))]
forall a'.
GQLNamedResolver (Resolver QUERY e m) a' =>
Proxy a' -> [ScanRef Proxy (GQLNamedResolver (Resolver QUERY e m))]
forall (f :: * -> *).
f a' -> [ScanRef Proxy (GQLNamedResolver (Resolver QUERY e m))]
forall (m :: * -> *) a (f :: * -> *).
GQLNamedResolver m a =>
f a -> [ScanRef Proxy (GQLNamedResolver m)]
deriveNamedRefs
    (Proxy (query (NamedResolverT (Resolver QUERY e m)))
 -> [CBox Proxy (GQLNamedResolver (Resolver QUERY e m))])
-> (NamedResolvers m e query mut sub
    -> Proxy (query (NamedResolverT (Resolver QUERY e m))))
-> NamedResolvers m e query mut sub
-> [CBox Proxy (GQLNamedResolver (Resolver QUERY e m))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedResolvers m e query mut sub
-> Proxy (query (NamedResolverT (Resolver QUERY e m)))
forall (m :: * -> *) e (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (sub :: (* -> *) -> *).
NamedResolvers m e query mut sub
-> Proxy (query (NamedResolverT (Resolver QUERY e m)))
queryProxy