{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Server.Deriving.App ( RootResolverConstraint, deriveSchema, deriveApp, ) where import Data.Morpheus.App ( App (..), mkApp, ) import Data.Morpheus.App.Internal.Resolving ( resultOr, ) import Data.Morpheus.Server.Deriving.Encode ( EncodeConstraints, deriveModel, ) import Data.Morpheus.Server.Deriving.Named.Encode ( EncodeNamedConstraints, deriveNamedModel, ) import Data.Morpheus.Server.Deriving.Schema ( SchemaConstraints, deriveSchema, ) import Data.Morpheus.Types ( NamedResolvers, RootResolver (..), ) import Relude type RootResolverConstraint m e query mutation subscription = ( EncodeConstraints e m query mutation subscription, SchemaConstraints e m query mutation subscription, Monad m ) type NamedResolversConstraint m e query mutation subscription = ( EncodeNamedConstraints e m query mutation subscription, SchemaConstraints e m query mutation subscription, Monad m ) class DeriveApp f m (event :: Type) (qu :: (Type -> Type) -> Type) (mu :: (Type -> Type) -> Type) (su :: (Type -> Type) -> Type) where deriveApp :: f m event qu mu su -> App event m instance RootResolverConstraint m e query mut sub => DeriveApp RootResolver m e query mut sub where deriveApp :: RootResolver m e query mut sub -> App e m deriveApp RootResolver m e query mut sub root = forall err a' a. (NonEmpty err -> a') -> (a -> a') -> Result err a -> a' resultOr forall event (m :: * -> *). GQLErrors -> App event m FailApp (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall (s :: Stage) e (m :: * -> *). ValidateSchema s => Schema s -> RootResolverValue e m -> App e m mkApp) forall a b. (a -> b) -> a -> b $ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {k} (root :: (* -> *) -> * -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k) (proxy :: k -> *) (m :: * -> *) e (query :: (* -> *) -> *) (mut :: (* -> *) -> *) (subs :: (* -> *) -> *). SchemaConstraints e m query mut subs => proxy (root m e query mut subs) -> GQLResult (Schema CONST) deriveSchema (forall a. a -> Identity a Identity RootResolver m e query mut sub root) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall e (m :: * -> *) (query :: (* -> *) -> *) (mut :: (* -> *) -> *) (sub :: (* -> *) -> *). (Monad m, EncodeConstraints e m query mut sub) => RootResolver m e query mut sub -> GQLResult (RootResolverValue e m) deriveModel RootResolver m e query mut sub root instance NamedResolversConstraint m e query mut sub => DeriveApp NamedResolvers m e query mut sub where deriveApp :: NamedResolvers m e query mut sub -> App e m deriveApp NamedResolvers m e query mut sub root = forall err a' a. (NonEmpty err -> a') -> (a -> a') -> Result err a -> a' resultOr forall event (m :: * -> *). GQLErrors -> App event m FailApp (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall (s :: Stage) e (m :: * -> *). ValidateSchema s => Schema s -> RootResolverValue e m -> App e m mkApp) forall a b. (a -> b) -> a -> b $ (,forall e (m :: * -> *) (query :: (* -> *) -> *) (mut :: (* -> *) -> *) (sub :: (* -> *) -> *). (Monad m, EncodeNamedConstraints e m query mut sub) => NamedResolvers m e query mut sub -> RootResolverValue e m deriveNamedModel NamedResolvers m e query mut sub root) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {k} (root :: (* -> *) -> * -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k) (proxy :: k -> *) (m :: * -> *) e (query :: (* -> *) -> *) (mut :: (* -> *) -> *) (subs :: (* -> *) -> *). SchemaConstraints e m query mut subs => proxy (root m e query mut subs) -> GQLResult (Schema CONST) deriveSchema (forall a. a -> Identity a Identity NamedResolvers m e query mut sub root)