{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.App.Internal.Resolving.RootResolverValue
  ( runRootResolverValue,
    RootResolverValue (..),
  )
where

import Control.Monad.Except (MonadError, throwError)
import qualified Data.Aeson as A
import Data.Morpheus.App.Internal.Resolving.Event
  ( EventHandler (..),
  )
import Data.Morpheus.App.Internal.Resolving.ResolveValue
import Data.Morpheus.App.Internal.Resolving.Resolver
  ( LiftOperation,
    Resolver,
    ResponseStream,
    runResolver,
  )
import Data.Morpheus.App.Internal.Resolving.ResolverState
  ( ResolverContext (..),
    ResolverState,
    runResolverStateT,
    toResolverStateT,
  )
import Data.Morpheus.App.Internal.Resolving.SchemaAPI (schemaAPI)
import Data.Morpheus.App.Internal.Resolving.Types
import Data.Morpheus.App.Internal.Resolving.Utils
  ( lookupResJSON,
  )
import Data.Morpheus.Internal.Ext (merge)
import Data.Morpheus.Internal.Utils
  ( empty,
  )
import Data.Morpheus.Types.Internal.AST
  ( GQLError,
    MUTATION,
    Operation (..),
    OperationType (..),
    QUERY,
    SUBSCRIPTION,
    Selection,
    SelectionContent (SelectionSet),
    SelectionSet,
    VALID,
    ValidValue,
    Value (..),
    internal,
    splitSystemSelection,
  )
import Relude hiding
  ( Show,
    empty,
    show,
  )

data RootResolverValue e m
  = RootResolverValue
      { forall e (m :: * -> *).
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m)),
        forall e (m :: * -> *).
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m)),
        forall e (m :: * -> *).
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m)),
        forall e (m :: * -> *).
RootResolverValue e m
-> Maybe (Selection VALID -> ResolverState (Channel e))
channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
      }
  | NamedResolversValue
      {forall e (m :: * -> *).
RootResolverValue e m -> ResolverMap (Resolver QUERY e m)
queryResolverMap :: ResolverMap (Resolver QUERY e m)}

instance Monad m => A.FromJSON (RootResolverValue e m) where
  parseJSON :: Value -> Parser (RootResolverValue e m)
parseJSON Value
res =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      RootResolverValue
        { queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver = forall (f :: * -> *) (m :: * -> *).
(MonadError GQLError f, MonadReader ResolverContext f,
 MonadReader ResolverContext m) =>
FieldName -> Value -> f (ObjectTypeResolver m)
lookupResJSON FieldName
"query" Value
res,
          mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver = forall (f :: * -> *) (m :: * -> *).
(MonadError GQLError f, MonadReader ResolverContext f,
 MonadReader ResolverContext m) =>
FieldName -> Value -> f (ObjectTypeResolver m)
lookupResJSON FieldName
"mutation" Value
res,
          subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver = forall (f :: * -> *) (m :: * -> *).
(MonadError GQLError f, MonadReader ResolverContext f,
 MonadReader ResolverContext m) =>
FieldName -> Value -> f (ObjectTypeResolver m)
lookupResJSON FieldName
"subscription" Value
res,
          channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
channelMap = forall a. Maybe a
Nothing
        }

runRootDataResolver ::
  (Monad m, LiftOperation o) =>
  Maybe (Selection VALID -> ResolverState (Channel e)) ->
  ResolverState (ObjectTypeResolver (Resolver o e m)) ->
  ResolverContext ->
  SelectionSet VALID ->
  ResponseStream e m (Value VALID)
runRootDataResolver :: forall (m :: * -> *) (o :: OperationType) e.
(Monad m, LiftOperation o) =>
Maybe (Selection VALID -> ResolverState (Channel e))
-> ResolverState (ObjectTypeResolver (Resolver o e m))
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
runRootDataResolver
  Maybe (Selection VALID -> ResolverState (Channel e))
channels
  ResolverState (ObjectTypeResolver (Resolver o e m))
res
  ResolverContext
ctx
  SelectionSet VALID
selection =
    do
      ObjectTypeResolver (Resolver o e m)
root <- forall e (m :: * -> *) a.
ResolverStateT e m a -> ResolverContext -> ResultT e m a
runResolverStateT (forall (m :: * -> *) a e.
Applicative m =>
ResolverState a -> ResolverStateT e m a
toResolverStateT ResolverState (ObjectTypeResolver (Resolver o e m))
res) ResolverContext
ctx
      forall (m :: * -> *) event (o :: OperationType).
Monad m =>
Maybe (Selection VALID -> ResolverState (Channel event))
-> Resolver o event m (Value VALID)
-> ResolverContext
-> ResponseStream event m (Value VALID)
runResolver Maybe (Selection VALID -> ResolverState (Channel e))
channels (forall (m :: * -> *).
(MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverMapContext m
-> ObjectTypeResolver m
-> Maybe (SelectionSet VALID)
-> m (Value VALID)
resolveObject (forall (m :: * -> *).
LocalCache -> ResolverMap m -> ResolverMapContext m
ResolverMapContext forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) ObjectTypeResolver (Resolver o e m)
root (forall a. a -> Maybe a
Just SelectionSet VALID
selection)) ResolverContext
ctx

runRootResolverValue :: Monad m => RootResolverValue e m -> ResolverContext -> ResponseStream e m (Value VALID)
runRootResolverValue :: forall (m :: * -> *) e.
Monad m =>
RootResolverValue e m
-> ResolverContext -> ResponseStream e m (Value VALID)
runRootResolverValue
  RootResolverValue
    { ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver :: forall e (m :: * -> *).
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver,
      ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver :: forall e (m :: * -> *).
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver,
      ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver :: forall e (m :: * -> *).
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver,
      Maybe (Selection VALID -> ResolverState (Channel e))
channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
channelMap :: forall e (m :: * -> *).
RootResolverValue e m
-> Maybe (Selection VALID -> ResolverState (Channel e))
channelMap
    }
  ctx :: ResolverContext
ctx@ResolverContext {operation :: ResolverContext -> Operation VALID
operation = Operation {OperationType
operationType :: forall (s :: Stage). Operation s -> OperationType
operationType :: OperationType
operationType, SelectionSet VALID
operationSelection :: forall (s :: Stage). Operation s -> SelectionSet s
operationSelection :: SelectionSet VALID
operationSelection}} =
    OperationType -> ResponseStream e m (Value VALID)
selectByOperation OperationType
operationType
    where
      selectByOperation :: OperationType -> ResponseStream e m (Value VALID)
selectByOperation OperationType
Query =
        forall (m :: * -> *) event.
Monad m =>
(SelectionSet VALID -> ResponseStream event m (Value VALID))
-> ResolverContext -> ResponseStream event m (Value VALID)
withIntrospection (forall (m :: * -> *) (o :: OperationType) e.
(Monad m, LiftOperation o) =>
Maybe (Selection VALID -> ResolverState (Channel e))
-> ResolverState (ObjectTypeResolver (Resolver o e m))
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
runRootDataResolver Maybe (Selection VALID -> ResolverState (Channel e))
channelMap ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver ResolverContext
ctx) ResolverContext
ctx
      selectByOperation OperationType
Mutation =
        forall (m :: * -> *) (o :: OperationType) e.
(Monad m, LiftOperation o) =>
Maybe (Selection VALID -> ResolverState (Channel e))
-> ResolverState (ObjectTypeResolver (Resolver o e m))
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
runRootDataResolver Maybe (Selection VALID -> ResolverState (Channel e))
channelMap ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver ResolverContext
ctx SelectionSet VALID
operationSelection
      selectByOperation OperationType
Subscription =
        forall (m :: * -> *) (o :: OperationType) e.
(Monad m, LiftOperation o) =>
Maybe (Selection VALID -> ResolverState (Channel e))
-> ResolverState (ObjectTypeResolver (Resolver o e m))
-> ResolverContext
-> SelectionSet VALID
-> ResponseStream e m (Value VALID)
runRootDataResolver Maybe (Selection VALID -> ResolverState (Channel e))
channelMap ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver ResolverContext
ctx SelectionSet VALID
operationSelection
runRootResolverValue
  NamedResolversValue {ResolverMap (Resolver QUERY e m)
queryResolverMap :: ResolverMap (Resolver QUERY e m)
queryResolverMap :: forall e (m :: * -> *).
RootResolverValue e m -> ResolverMap (Resolver QUERY e m)
queryResolverMap}
  ctx :: ResolverContext
ctx@ResolverContext {operation :: ResolverContext -> Operation VALID
operation = Operation {OperationType
operationType :: OperationType
operationType :: forall (s :: Stage). Operation s -> OperationType
operationType}} =
    OperationType -> ResponseStream e m (Value VALID)
selectByOperation OperationType
operationType
    where
      selectByOperation :: OperationType -> ResponseStream e m (Value VALID)
selectByOperation OperationType
Query = forall (m :: * -> *) event.
Monad m =>
(SelectionSet VALID -> ResponseStream event m (Value VALID))
-> ResolverContext -> ResponseStream event m (Value VALID)
withIntrospection (\SelectionSet VALID
sel -> forall (m :: * -> *) event (o :: OperationType).
Monad m =>
Maybe (Selection VALID -> ResolverState (Channel event))
-> Resolver o event m (Value VALID)
-> ResolverContext
-> ResponseStream event m (Value VALID)
runResolver forall a. Maybe a
Nothing (MergeMap 'False FieldName (Selection VALID)
-> Resolver QUERY e m (Value VALID)
resolvedValue SelectionSet VALID
sel) ResolverContext
ctx) ResolverContext
ctx
        where
          resolvedValue :: MergeMap 'False FieldName (Selection VALID)
-> Resolver QUERY e m (Value VALID)
resolvedValue MergeMap 'False FieldName (Selection VALID)
selection = forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ResolverMapContext m
-> NamedResolverRef -> SelectionContent VALID -> m (Value VALID)
resolveRef (forall (m :: * -> *).
LocalCache -> ResolverMap m -> ResolverMapContext m
ResolverMapContext forall coll. Empty coll => coll
empty ResolverMap (Resolver QUERY e m)
queryResolverMap) (Name 'TYPE -> NamedResolverArg -> NamedResolverRef
NamedResolverRef Name 'TYPE
"Query" [Value VALID
"ROOT"]) (forall (s :: Stage). SelectionSet s -> SelectionContent s
SelectionSet MergeMap 'False FieldName (Selection VALID)
selection)
      selectByOperation OperationType
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"mutation and subscription is not supported for namedResolvers"

withIntrospection :: Monad m => (SelectionSet VALID -> ResponseStream event m ValidValue) -> ResolverContext -> ResponseStream event m ValidValue
withIntrospection :: forall (m :: * -> *) event.
Monad m =>
(SelectionSet VALID -> ResponseStream event m (Value VALID))
-> ResolverContext -> ResponseStream event m (Value VALID)
withIntrospection SelectionSet VALID -> ResponseStream event m (Value VALID)
f ctx :: ResolverContext
ctx@ResolverContext {Operation VALID
operation :: Operation VALID
operation :: ResolverContext -> Operation VALID
operation} = case forall (s :: Stage).
SelectionSet s -> (Maybe (SelectionSet s), Maybe (SelectionSet s))
splitSystemSelection (forall (s :: Stage). Operation s -> SelectionSet s
operationSelection Operation VALID
operation) of
  (Maybe (SelectionSet VALID)
Nothing, Maybe (SelectionSet VALID)
_) -> SelectionSet VALID -> ResponseStream event m (Value VALID)
f (forall (s :: Stage). Operation s -> SelectionSet s
operationSelection Operation VALID
operation)
  (Just SelectionSet VALID
intro, Maybe (SelectionSet VALID)
Nothing) -> forall (m :: * -> *) event.
Monad m =>
SelectionSet VALID
-> ResolverContext -> ResponseStream event m (Value VALID)
introspection SelectionSet VALID
intro ResolverContext
ctx
  (Just SelectionSet VALID
intro, Just SelectionSet VALID
selection) -> do
    Value VALID
x <- SelectionSet VALID -> ResponseStream event m (Value VALID)
f SelectionSet VALID
selection
    Value VALID
y <- forall (m :: * -> *) event.
Monad m =>
SelectionSet VALID
-> ResolverContext -> ResponseStream event m (Value VALID)
introspection SelectionSet VALID
intro ResolverContext
ctx
    forall (m :: * -> *).
MonadError GQLError m =>
Value VALID -> Value VALID -> m (Value VALID)
mergeRoot Value VALID
y Value VALID
x

introspection :: Monad m => SelectionSet VALID -> ResolverContext -> ResponseStream event m ValidValue
introspection :: forall (m :: * -> *) event.
Monad m =>
SelectionSet VALID
-> ResolverContext -> ResponseStream event m (Value VALID)
introspection SelectionSet VALID
selection ctx :: ResolverContext
ctx@ResolverContext {Schema VALID
schema :: ResolverContext -> Schema VALID
schema :: Schema VALID
schema} = forall (m :: * -> *) event (o :: OperationType).
Monad m =>
Maybe (Selection VALID -> ResolverState (Channel event))
-> Resolver o event m (Value VALID)
-> ResolverContext
-> ResponseStream event m (Value VALID)
runResolver forall a. Maybe a
Nothing (forall (m :: * -> *).
(MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverMapContext m
-> ObjectTypeResolver m
-> Maybe (SelectionSet VALID)
-> m (Value VALID)
resolveObject (forall (m :: * -> *).
LocalCache -> ResolverMap m -> ResolverMapContext m
ResolverMapContext forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) (forall (m :: * -> *) e.
Monad m =>
Schema VALID -> ObjectTypeResolver (Resolver QUERY e m)
schemaAPI Schema VALID
schema) (forall a. a -> Maybe a
Just SelectionSet VALID
selection)) ResolverContext
ctx

mergeRoot :: MonadError GQLError m => ValidValue -> ValidValue -> m ValidValue
mergeRoot :: forall (m :: * -> *).
MonadError GQLError m =>
Value VALID -> Value VALID -> m (Value VALID)
mergeRoot (Object Object VALID
x) (Object Object VALID
y) = forall (stage :: Stage). Object stage -> Value stage
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge Object VALID
x Object VALID
y
mergeRoot Value VALID
_ Value VALID
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"can't merge non object types")