{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.App.Internal.Stitching
( Stitching (..),
)
where
import Control.Monad.Except (MonadError (throwError))
import Data.Morpheus.App.Internal.Resolving (RootResolverValue (..))
import Data.Morpheus.App.Internal.Resolving.Types
( NamedResolver (..),
NamedResolverResult (..),
)
import qualified Data.Morpheus.App.Internal.Resolving.Types as R
import Data.Morpheus.Error (NameCollision (..))
import Data.Morpheus.Internal.Ext
( Merge (merge),
resolveWith,
runResolutionT,
unsafeFromList,
)
import Data.Morpheus.Internal.Utils
( mergeT,
prop,
)
import Data.Morpheus.Types.Internal.AST
( DirectiveDefinition,
Directives,
DirectivesDefinition,
FieldDefinition,
FieldsDefinition,
GQLError,
Schema (..),
TRUE,
TypeContent (..),
TypeDefinition (..),
TypeDefinitions,
)
import Relude hiding (optional)
equal :: (Eq a, Applicative m, MonadError GQLError m) => GQLError -> a -> a -> m a
equal :: forall a (m :: * -> *).
(Eq a, Applicative m, MonadError GQLError m) =>
GQLError -> a -> a -> m a
equal GQLError
err a
p1 a
p2
| a
p1 forall a. Eq a => a -> a -> Bool
== a
p2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
p2
| Bool
otherwise = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
err
fstM :: Applicative m => a -> a -> m a
fstM :: forall (m :: * -> *) a. Applicative m => a -> a -> m a
fstM a
x a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
concatM :: (Applicative m, Semigroup a) => a -> a -> m a
concatM :: forall (m :: * -> *) a.
(Applicative m, Semigroup a) =>
a -> a -> m a
concatM a
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x forall a. Semigroup a => a -> a -> a
<>)
class Stitching a where
stitch :: (Monad m, MonadError GQLError m) => a -> a -> m a
instance Stitching a => Stitching (Maybe a) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
Maybe a -> Maybe a -> m (Maybe a)
stitch = forall (f :: * -> *) t.
Applicative f =>
(t -> t -> f t) -> Maybe t -> Maybe t -> f (Maybe t)
optional forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch
instance Stitching (Schema s) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
Schema s -> Schema s -> m (Schema s)
stitch Schema s
s1 Schema s
s2 =
forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch forall (s :: Stage). Schema s -> TypeDefinitions s
types Schema s
s1 Schema s
s2
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall (m :: * -> *) (c :: TypeCategory) (s :: Stage).
(Monad m, MonadError GQLError m) =>
TypeDefinition c s -> TypeDefinition c s -> m (TypeDefinition c s)
stitchOperation forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
s1 Schema s
s2
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop (forall (f :: * -> *) t.
Applicative f =>
(t -> t -> f t) -> Maybe t -> Maybe t -> f (Maybe t)
optional forall (m :: * -> *) (c :: TypeCategory) (s :: Stage).
(Monad m, MonadError GQLError m) =>
TypeDefinition c s -> TypeDefinition c s -> m (TypeDefinition c s)
stitchOperation) forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
s1 Schema s
s2
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop (forall (f :: * -> *) t.
Applicative f =>
(t -> t -> f t) -> Maybe t -> Maybe t -> f (Maybe t)
optional forall (m :: * -> *) (c :: TypeCategory) (s :: Stage).
(Monad m, MonadError GQLError m) =>
TypeDefinition c s -> TypeDefinition c s -> m (TypeDefinition c s)
stitchOperation) forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
s1 Schema s
s2
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions Schema s
s1 Schema s
s2
instance Stitching (TypeDefinitions s) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
TypeDefinitions s -> TypeDefinitions s -> m (TypeDefinitions s)
stitch TypeDefinitions s
x TypeDefinitions s
y = forall k a coll (m :: * -> *) b.
ResolutionT k a coll m b
-> ([(k, a)] -> coll) -> (NonEmpty a -> m a) -> m b
runResolutionT (forall k a (t :: * -> *) (m :: * -> *) c.
(KeyOf k a, Foldable t, Monad m) =>
t a -> t a -> ResolutionT k a c m c
mergeT TypeDefinitions s
x TypeDefinitions s
y) forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList (forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmpty a -> m a
resolveWith forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch)
instance Stitching (DirectivesDefinition s) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
DirectivesDefinition s
-> DirectivesDefinition s -> m (DirectivesDefinition s)
stitch DirectivesDefinition s
x DirectivesDefinition s
y = forall k a coll (m :: * -> *) b.
ResolutionT k a coll m b
-> ([(k, a)] -> coll) -> (NonEmpty a -> m a) -> m b
runResolutionT (forall k a (t :: * -> *) (m :: * -> *) c.
(KeyOf k a, Foldable t, Monad m) =>
t a -> t a -> ResolutionT k a c m c
mergeT DirectivesDefinition s
x DirectivesDefinition s
y) forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList (forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmpty a -> m a
resolveWith forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch)
instance Stitching (Directives s) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
Directives s -> Directives s -> m (Directives s)
stitch = forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge
optional :: Applicative f => (t -> t -> f t) -> Maybe t -> Maybe t -> f (Maybe t)
optional :: forall (f :: * -> *) t.
Applicative f =>
(t -> t -> f t) -> Maybe t -> Maybe t -> f (Maybe t)
optional t -> t -> f t
_ Maybe t
Nothing Maybe t
y = forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe t
y
optional t -> t -> f t
_ (Just t
x) Maybe t
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just t
x)
optional t -> t -> f t
f (Just t
x) (Just t
y) = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> t -> f t
f t
x t
y
stitchOperation ::
(Monad m, MonadError GQLError m) =>
TypeDefinition c s ->
TypeDefinition c s ->
m (TypeDefinition c s)
stitchOperation :: forall (m :: * -> *) (c :: TypeCategory) (s :: Stage).
(Monad m, MonadError GQLError m) =>
TypeDefinition c s -> TypeDefinition c s -> m (TypeDefinition c s)
stitchOperation TypeDefinition c s
x TypeDefinition c s
y =
forall (a :: TypeCategory) (s :: Stage).
Maybe Description
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall (m :: * -> *) a.
(Applicative m, Semigroup a) =>
a -> a -> m a
concatM forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Description
typeDescription TypeDefinition c s
x TypeDefinition c s
y
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall (m :: * -> *) a. Applicative m => a -> a -> m a
fstM forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition c s
x TypeDefinition c s
y
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeDirectives TypeDefinition c s
x TypeDefinition c s
y
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition c s
x TypeDefinition c s
y
instance Stitching (DirectiveDefinition s) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
DirectiveDefinition s
-> DirectiveDefinition s -> m (DirectiveDefinition s)
stitch DirectiveDefinition s
x DirectiveDefinition s
y
| DirectiveDefinition s
x forall a. Eq a => a -> a -> Bool
== DirectiveDefinition s
y = forall (f :: * -> *) a. Applicative f => a -> f a
pure DirectiveDefinition s
x
| Bool
otherwise = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"only directives with same structure can be merged"
instance Stitching (TypeDefinition cat s) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
TypeDefinition cat s
-> TypeDefinition cat s -> m (TypeDefinition cat s)
stitch TypeDefinition cat s
x TypeDefinition cat s
y =
forall (a :: TypeCategory) (s :: Stage).
Maybe Description
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall (m :: * -> *) a.
(Applicative m, Semigroup a) =>
a -> a -> m a
concatM forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Description
typeDescription TypeDefinition cat s
x TypeDefinition cat s
y
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop (forall a (m :: * -> *).
(Eq a, Applicative m, MonadError GQLError m) =>
GQLError -> a -> a -> m a
equal forall a b. (a -> b) -> a -> b
$ forall e a. NameCollision e a => a -> e
nameCollision TypeDefinition cat s
y) forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition cat s
x TypeDefinition cat s
y
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeDirectives TypeDefinition cat s
x TypeDefinition cat s
y
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b (m :: * -> *) a.
(b -> b -> m b) -> (a -> b) -> a -> a -> m b
prop forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition cat s
x TypeDefinition cat s
y
instance Stitching (TypeContent TRUE cat s) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
TypeContent TRUE cat s
-> TypeContent TRUE cat s -> m (TypeContent TRUE cat s)
stitch (DataScalar ScalarDefinition
_) (DataScalar ScalarDefinition
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> TypeContent (LEAF <=? a) a s
DataScalar ScalarDefinition
x
stitch (DataObject [TypeName]
i1 FieldsDefinition OUT s
fields1) (DataObject [TypeName]
i2 FieldsDefinition OUT s
fields2) =
forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (OBJECT <=? a) a s
DataObject ([TypeName]
i1 forall a. Semigroup a => a -> a -> a
<> [TypeName]
i2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch FieldsDefinition OUT s
fields1 FieldsDefinition OUT s
fields2
stitch TypeContent TRUE cat s
x TypeContent TRUE cat s
y
| TypeContent TRUE cat s
x forall a. Eq a => a -> a -> Bool
== TypeContent TRUE cat s
y = forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeContent TRUE cat s
y
| Bool
otherwise = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError
"Schema Stitching works only for objects" :: GQLError)
instance Stitching (FieldsDefinition cat s) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
FieldsDefinition cat s
-> FieldsDefinition cat s -> m (FieldsDefinition cat s)
stitch FieldsDefinition cat s
x FieldsDefinition cat s
y = forall k a coll (m :: * -> *) b.
ResolutionT k a coll m b
-> ([(k, a)] -> coll) -> (NonEmpty a -> m a) -> m b
runResolutionT (forall k a (t :: * -> *) (m :: * -> *) c.
(KeyOf k a, Foldable t, Monad m) =>
t a -> t a -> ResolutionT k a c m c
mergeT FieldsDefinition cat s
x FieldsDefinition cat s
y) forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList (forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmpty a -> m a
resolveWith forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch)
instance Stitching (FieldDefinition cat s) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
FieldDefinition cat s
-> FieldDefinition cat s -> m (FieldDefinition cat s)
stitch FieldDefinition cat s
old FieldDefinition cat s
new
| FieldDefinition cat s
old forall a. Eq a => a -> a -> Bool
== FieldDefinition cat s
new = forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldDefinition cat s
old
| Bool
otherwise = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall e a. NameCollision e a => a -> e
nameCollision FieldDefinition cat s
new
rootProp :: (Monad m, Merge m b) => (a -> m b) -> a -> a -> m b
rootProp :: forall (m :: * -> *) b a.
(Monad m, Merge m b) =>
(a -> m b) -> a -> a -> m b
rootProp a -> m b
f a
x a
y = do
b
x' <- a -> m b
f a
x
b
y' <- a -> m b
f a
y
forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge b
x' b
y'
stitchSubscriptions :: MonadError GQLError m => Maybe a -> Maybe a -> m (Maybe a)
stitchSubscriptions :: forall (m :: * -> *) a.
MonadError GQLError m =>
Maybe a -> Maybe a -> m (Maybe a)
stitchSubscriptions Just {} Just {} = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError
"can't merge subscription applications" :: GQLError)
stitchSubscriptions Maybe a
x Maybe a
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
x
stitchSubscriptions Maybe a
Nothing Maybe a
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
x
instance Stitching (R.ObjectTypeResolver m) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
ObjectTypeResolver m
-> ObjectTypeResolver m -> m (ObjectTypeResolver m)
stitch ObjectTypeResolver m
t1 ObjectTypeResolver m
t2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m
R.ObjectTypeResolver (forall (m :: * -> *).
ObjectTypeResolver m -> HashMap FieldName (m (ResolverValue m))
R.objectFields ObjectTypeResolver m
t1 forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
ObjectTypeResolver m -> HashMap FieldName (m (ResolverValue m))
R.objectFields ObjectTypeResolver m
t2)
instance (MonadError GQLError m) => Stitching (NamedResolverResult m) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
NamedResolverResult m
-> NamedResolverResult m -> m (NamedResolverResult m)
stitch NamedScalarResolver {} (NamedScalarResolver ScalarValue
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *). ScalarValue -> NamedResolverResult m
NamedScalarResolver ScalarValue
f)
stitch NamedEnumResolver {} (NamedEnumResolver TypeName
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *). TypeName -> NamedResolverResult m
NamedEnumResolver TypeName
x)
stitch NamedUnionResolver {} (NamedUnionResolver NamedResolverRef
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *). NamedResolverRef -> NamedResolverResult m
NamedUnionResolver NamedResolverRef
x)
stitch (NamedObjectResolver ObjectTypeResolver m
t1) (NamedObjectResolver ObjectTypeResolver m
t2) = forall (m :: * -> *). ObjectTypeResolver m -> NamedResolverResult m
NamedObjectResolver forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch ObjectTypeResolver m
t1 ObjectTypeResolver m
t2
stitch NamedResolverResult m
NamedNullResolver NamedResolverResult m
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure NamedResolverResult m
x
stitch NamedResolverResult m
x NamedResolverResult m
NamedNullResolver = forall (f :: * -> *) a. Applicative f => a -> f a
pure NamedResolverResult m
x
stitch NamedResolverResult m
_ NamedResolverResult m
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"ResolverMap must have same Kind"
instance (MonadError GQLError m) => Stitching (NamedResolver m) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
NamedResolver m -> NamedResolver m -> m (NamedResolver m)
stitch NamedResolver m
t1 NamedResolver m
t2
| forall (m :: * -> *). NamedResolver m -> TypeName
resolverName NamedResolver m
t1 forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). NamedResolver m -> TypeName
resolverName NamedResolver m
t2 =
forall (f :: * -> *) a. Applicative f => a -> f a
pure
NamedResolver
{ resolverName :: TypeName
resolverName = forall (m :: * -> *). NamedResolver m -> TypeName
resolverName NamedResolver m
t1,
resolverFun :: NamedResolverFun m
resolverFun = \NamedResolverArg
arg -> do
[NamedResolverResult m]
t1' <- forall (m :: * -> *). NamedResolver m -> NamedResolverFun m
resolverFun NamedResolver m
t1 NamedResolverArg
arg
[NamedResolverResult m]
t2' <- forall (m :: * -> *). NamedResolver m -> NamedResolverFun m
resolverFun NamedResolver m
t2 NamedResolverArg
arg
let xs :: [(NamedResolverResult m, NamedResolverResult m)]
xs = forall a b. [a] -> [b] -> [(a, b)]
zip [NamedResolverResult m]
t1' [NamedResolverResult m]
t2'
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch) [(NamedResolverResult m, NamedResolverResult m)]
xs
}
| Bool
otherwise = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"ResolverMap must have same resolverName"
instance Monad m => Stitching (RootResolverValue e m) where
stitch :: forall (m :: * -> *).
(Monad m, MonadError GQLError m) =>
RootResolverValue e m
-> RootResolverValue e m -> m (RootResolverValue e m)
stitch x :: RootResolverValue e m
x@RootResolverValue {} y :: RootResolverValue e m
y@RootResolverValue {} = do
Maybe (Selection VALID -> ResolverState (Channel e))
channelMap <- forall (m :: * -> *) a.
MonadError GQLError m =>
Maybe a -> Maybe a -> m (Maybe a)
stitchSubscriptions (forall e (m :: * -> *).
RootResolverValue e m
-> Maybe (Selection VALID -> ResolverState (Channel e))
channelMap RootResolverValue e m
x) (forall e (m :: * -> *).
RootResolverValue e m
-> Maybe (Selection VALID -> ResolverState (Channel e))
channelMap RootResolverValue e m
y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
RootResolverValue
{ queryResolver :: ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver = forall (m :: * -> *) b a.
(Monad m, Merge m b) =>
(a -> m b) -> a -> a -> m b
rootProp forall e (m :: * -> *).
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver QUERY e m))
queryResolver RootResolverValue e m
x RootResolverValue e m
y,
mutationResolver :: ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver = forall (m :: * -> *) b a.
(Monad m, Merge m b) =>
(a -> m b) -> a -> a -> m b
rootProp forall e (m :: * -> *).
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver MUTATION e m))
mutationResolver RootResolverValue e m
x RootResolverValue e m
y,
subscriptionResolver :: ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver = forall (m :: * -> *) b a.
(Monad m, Merge m b) =>
(a -> m b) -> a -> a -> m b
rootProp forall e (m :: * -> *).
RootResolverValue e m
-> ResolverState (ObjectTypeResolver (Resolver SUBSCRIPTION e m))
subscriptionResolver RootResolverValue e m
x RootResolverValue e m
y,
Maybe (Selection VALID -> ResolverState (Channel e))
channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
channelMap :: Maybe (Selection VALID -> ResolverState (Channel e))
channelMap
}
stitch
NamedResolversValue
{ queryResolverMap :: forall e (m :: * -> *).
RootResolverValue e m -> ResolverMap (Resolver QUERY e m)
queryResolverMap = ResolverMap (Resolver QUERY e m)
q1
}
NamedResolversValue
{ queryResolverMap :: forall e (m :: * -> *).
RootResolverValue e m -> ResolverMap (Resolver QUERY e m)
queryResolverMap = ResolverMap (Resolver QUERY e m)
q2
} =
do
ResolverMap (Resolver QUERY e m)
result <- forall k a coll (m :: * -> *) b.
ResolutionT k a coll m b
-> ([(k, a)] -> coll) -> (NonEmpty a -> m a) -> m b
runResolutionT (forall k a (t :: * -> *) (m :: * -> *) c.
(KeyOf k a, Foldable t, Monad m) =>
t a -> t a -> ResolutionT k a c m c
mergeT ResolverMap (Resolver QUERY e m)
q1 ResolverMap (Resolver QUERY e m)
q2) forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList (forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmpty a -> m a
resolveWith forall a (m :: * -> *).
(Stitching a, Monad m, MonadError GQLError m) =>
a -> a -> m a
stitch)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedResolversValue {queryResolverMap :: ResolverMap (Resolver QUERY e m)
queryResolverMap = ResolverMap (Resolver QUERY e m)
result})
stitch RootResolverValue e m
_ RootResolverValue e m
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"only apps with same resolver model can be merged"