{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# 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.Internal.Ext (GQLResult)
import Data.Morpheus.Server.Deriving.Internal.Resolve.Explore
  ( 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.GScan
  ( ScanRef,
    Scanner (..),
    scan,
  )
import Data.Morpheus.Server.Deriving.Utils.Proxy
  ( ContextValue (..),
  )
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)

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

instance
  (GQLType a, KindedNamedResolver GQLNamedResolver GQLNamedResolverFun GQLType GQLValue m (KIND a) a) =>
  GQLNamedResolver m a
  where
  deriveNamedRes :: forall (f :: * -> *). f a -> [NamedResolver m]
deriveNamedRes = forall {k} (namedRes :: (* -> *) -> * -> Constraint)
       (resFun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint) (m :: * -> *) (k :: DerivingKind) (a :: k)
       (f :: DerivingKind -> k -> *).
KindedNamedResolver namedRes resFun gql val m k a =>
UseNamedResolver namedRes resFun gql val
-> f k a -> [NamedResolver m]
kindedNamedResolver UseNamedResolver
  GQLNamedResolver GQLNamedResolverFun GQLType GQLValue
withNamed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. f a -> KindedProxy (KIND a) a
kindedProxy
  deriveNamedRefs :: forall (f :: * -> *). f a -> [ScanRef (GQLNamedResolver m)]
deriveNamedRefs = forall {k} (namedRes :: (* -> *) -> * -> Constraint)
       (resFun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint) (m :: * -> *) (k :: DerivingKind) (a :: k)
       (f :: DerivingKind -> k -> *).
KindedNamedResolver namedRes resFun gql val m k a =>
UseNamedResolver namedRes resFun gql val
-> f k a -> [ScanRef (namedRes m)]
kindedNamedRefs UseNamedResolver
  GQLNamedResolver GQLNamedResolverFun GQLType GQLValue
withNamed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. f a -> KindedProxy (KIND a) a
kindedProxy

instance KindedNamedFunValue GQLNamedResolverFun GQLType GQLValue (KIND a) m a => GQLNamedResolverFun m a where
  deriveNamedResFun :: a -> m (ResolverValue m)
deriveNamedResFun a
resolver = forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint)
       (k :: DerivingKind) (m :: * -> *) a
       (namedRes :: (* -> *) -> * -> Constraint).
KindedNamedFunValue res gql val k m a =>
UseNamedResolver namedRes res gql val
-> ContextValue k a -> m (ResolverValue m)
kindedNamedFunValue UseNamedResolver
  GQLNamedResolver GQLNamedResolverFun GQLType GQLValue
withNamed (forall (kind :: DerivingKind) a. a -> ContextValue kind a
ContextValue a
resolver :: ContextValue (KIND a) a)

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

deriveNamedResolver :: Scanner (GQLNamedResolver m) (NamedResolver m)
deriveNamedResolver :: forall (m :: * -> *).
Scanner (GQLNamedResolver m) (NamedResolver m)
deriveNamedResolver = Scanner {scannerFun :: forall (f :: * -> *) a.
GQLNamedResolver m a =>
f a -> [NamedResolver m]
scannerFun = forall (m :: * -> *) a (f :: * -> *).
GQLNamedResolver m a =>
f a -> [NamedResolver m]
deriveNamedRes, scannerRefs :: forall (f :: * -> *) a.
GQLNamedResolver m a =>
f a -> [ScanRef (GQLNamedResolver m)]
scannerRefs = forall (m :: * -> *) a (f :: * -> *).
GQLNamedResolver m a =>
f a -> [ScanRef (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
      GQLNamedResolver
      GQLNamedResolverFun
      GQLType
      GQLValue
      m
      (KIND (query (NamedResolverT 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)
subscriptionResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *)
       (mutation :: (* -> *) -> *) (subscription :: (* -> *) -> *).
RootResolver m event query mutation subscription
-> subscription (Resolver SUBSCRIPTION event m)
mutationResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *)
       (mutation :: (* -> *) -> *) (subscription :: (* -> *) -> *).
RootResolver m event query mutation subscription
-> mutation (Resolver MUTATION event m)
queryResolver :: forall (m :: * -> *) event (query :: (* -> *) -> *)
       (mutation :: (* -> *) -> *) (subscription :: (* -> *) -> *).
RootResolver m event query mutation subscription
-> query (Resolver QUERY event m)
subscriptionResolver :: sub (Resolver SUBSCRIPTION e m)
mutationResolver :: mut (Resolver MUTATION e m)
queryResolver :: query (Resolver QUERY e m)
..} =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    RootResolverValue
      { queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver = 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 = 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 = 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 =
          forall (f :: * -> *) a. GQLType a => f a -> Maybe (f a)
ignoreUndefined (forall a. a -> Identity a
Identity sub (Resolver SUBSCRIPTION e m)
subscriptionResolver)
            forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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
      }

deriveNamedResolvers ::
  forall e m query mut sub.
  (Monad m, DERIVE_NAMED_RESOLVERS (Resolver QUERY e m) query) =>
  NamedResolvers m e query mut sub ->
  RootResolverValue e m
deriveNamedResolvers :: forall e (m :: * -> *) (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (sub :: (* -> *) -> *).
(Monad m, DERIVE_NAMED_RESOLVERS (Resolver QUERY e m) query) =>
NamedResolvers m e query mut sub -> RootResolverValue e m
deriveNamedResolvers NamedResolvers m e query mut sub
NamedResolvers =
  forall e (m :: * -> *).
ResolverMap (Resolver QUERY e m) -> RootResolverValue e m
NamedResolversValue forall a b. (a -> b) -> a -> b
$
    forall k b (c :: * -> Constraint).
(Hashable k, Eq k) =>
(b -> k) -> Scanner c b -> [ScanRef c] -> HashMap k b
scan
      forall (m :: * -> *). NamedResolver m -> TypeName
resolverName
      forall (m :: * -> *).
Scanner (GQLNamedResolver m) (NamedResolver m)
deriveNamedResolver
      (forall (m :: * -> *) a (f :: * -> *).
GQLNamedResolver m a =>
f a -> [ScanRef (GQLNamedResolver m)]
deriveNamedRefs (forall {k} (t :: k). Proxy t
Proxy @(query (NamedResolverT (Resolver QUERY e m)))))