{-# 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 = (NonEmpty GQLError -> App e m) -> ((Schema CONST, RootResolverValue e m) -> App e m) -> Result GQLError (Schema CONST, RootResolverValue e m) -> App e m forall err a' a. (NonEmpty err -> a') -> (a -> a') -> Result err a -> a' resultOr NonEmpty GQLError -> App e m forall event (m :: * -> *). NonEmpty GQLError -> App event m FailApp ((Schema CONST -> RootResolverValue e m -> App e m) -> (Schema CONST, RootResolverValue e m) -> App e m forall a b c. (a -> b -> c) -> (a, b) -> c uncurry Schema CONST -> RootResolverValue e m -> App e m forall (s :: Stage) e (m :: * -> *). ValidateSchema s => Schema s -> RootResolverValue e m -> App e m mkApp) (Result GQLError (Schema CONST, RootResolverValue e m) -> App e m) -> Result GQLError (Schema CONST, RootResolverValue e m) -> App e m forall a b. (a -> b) -> a -> b $ (,) (Schema CONST -> RootResolverValue e m -> (Schema CONST, RootResolverValue e m)) -> Result GQLError (Schema CONST) -> Result GQLError (RootResolverValue e m -> (Schema CONST, RootResolverValue e m)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Identity (RootResolver m e query mut sub) -> Result GQLError (Schema CONST) forall k (root :: (* -> *) -> * -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k) (proxy :: k -> *) (m :: * -> *) e (query :: (* -> *) -> *) (mut :: (* -> *) -> *) (subs :: (* -> *) -> *). SchemaConstraints e m query mut subs => proxy (root m e query mut subs) -> Result GQLError (Schema CONST) deriveSchema (RootResolver m e query mut sub -> Identity (RootResolver m e query mut sub) forall a. a -> Identity a Identity RootResolver m e query mut sub root) Result GQLError (RootResolverValue e m -> (Schema CONST, RootResolverValue e m)) -> Result GQLError (RootResolverValue e m) -> Result GQLError (Schema CONST, RootResolverValue e m) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> RootResolver m e query mut sub -> Result GQLError (RootResolverValue e m) 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 = (NonEmpty GQLError -> App e m) -> ((Schema CONST, RootResolverValue e m) -> App e m) -> Result GQLError (Schema CONST, RootResolverValue e m) -> App e m forall err a' a. (NonEmpty err -> a') -> (a -> a') -> Result err a -> a' resultOr NonEmpty GQLError -> App e m forall event (m :: * -> *). NonEmpty GQLError -> App event m FailApp ((Schema CONST -> RootResolverValue e m -> App e m) -> (Schema CONST, RootResolverValue e m) -> App e m forall a b c. (a -> b -> c) -> (a, b) -> c uncurry Schema CONST -> RootResolverValue e m -> App e m forall (s :: Stage) e (m :: * -> *). ValidateSchema s => Schema s -> RootResolverValue e m -> App e m mkApp) (Result GQLError (Schema CONST, RootResolverValue e m) -> App e m) -> Result GQLError (Schema CONST, RootResolverValue e m) -> App e m forall a b. (a -> b) -> a -> b $ (,NamedResolvers m e query mut sub -> RootResolverValue e m 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) (Schema CONST -> (Schema CONST, RootResolverValue e m)) -> Result GQLError (Schema CONST) -> Result GQLError (Schema CONST, RootResolverValue e m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Identity (NamedResolvers m e query mut sub) -> Result GQLError (Schema CONST) forall k (root :: (* -> *) -> * -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k) (proxy :: k -> *) (m :: * -> *) e (query :: (* -> *) -> *) (mut :: (* -> *) -> *) (subs :: (* -> *) -> *). SchemaConstraints e m query mut subs => proxy (root m e query mut subs) -> Result GQLError (Schema CONST) deriveSchema (NamedResolvers m e query mut sub -> Identity (NamedResolvers m e query mut sub) forall a. a -> Identity a Identity NamedResolvers m e query mut sub root)