{-# 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
  -- TODO: app level constraint ensures that they have same re4solver function
  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
  -- NUll
  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"