morpheus-graphql-server 0.25.0 → 0.26.0
raw patch · 40 files changed
+838/−52 lines, 40 filesdep ~morpheus-graphql-appdep ~morpheus-graphql-coredep ~morpheus-graphql-subscriptionsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: morpheus-graphql-app, morpheus-graphql-core, morpheus-graphql-subscriptions, morpheus-graphql-tests
API changes (from Hackage documentation)
+ Data.Morpheus.Server.Resolvers: ignoreBatching :: Monad m => (a -> m b) -> [a] -> m [Maybe b]
+ Data.Morpheus.Server.Types: data GQLError
- Data.Morpheus.Server.Resolvers: [Ref] :: ResolveNamed m a => m (Dep a) -> NamedResolverT m a
+ Data.Morpheus.Server.Resolvers: [Ref] :: ResolveNamed m (Target a) => m (Dependency a) -> NamedResolverT m a
- Data.Morpheus.Server.Resolvers: [Refs] :: ResolveNamed m a => m [Dep a] -> NamedResolverT m [a]
+ Data.Morpheus.Server.Resolvers: [Refs] :: ResolveNamed m (Target a) => m [Dependency a] -> NamedResolverT m [a]
- Data.Morpheus.Server.Resolvers: class (ToJSON (Dep a)) => ResolveNamed (m :: Type -> Type) (a :: Type) where {
+ Data.Morpheus.Server.Resolvers: class ToJSON (Dependency a) => ResolveNamed (m :: Type -> Type) (a :: Type) where {
- Data.Morpheus.Server.Resolvers: resolve :: forall m a b. ResolveByType (RES_TYPE a b) m a b => Monad m => m a -> NamedResolverT m b
+ Data.Morpheus.Server.Resolvers: resolve :: forall m a b. ResolveRef (NamedResolverTarget b) m a b => Monad m => m a -> NamedResolverT m b
- Data.Morpheus.Server.Resolvers: resolveBatched :: (ResolveNamed m a, Monad m) => [Dep a] -> m [Maybe a]
+ Data.Morpheus.Server.Resolvers: resolveBatched :: (ResolveNamed m a, MonadError GQLError m) => [Dependency a] -> m [Maybe a]
- Data.Morpheus.Server.Resolvers: resolveNamed :: (ResolveNamed m a, Monad m) => Dep a -> m a
+ Data.Morpheus.Server.Resolvers: resolveNamed :: (ResolveNamed m a, MonadError GQLError m) => Dependency a -> m a
- Data.Morpheus.Server.Resolvers: useBatched :: (ResolveNamed m a, MonadError GQLError m) => Dep a -> m a
+ Data.Morpheus.Server.Resolvers: useBatched :: (ResolveNamed m a, MonadError GQLError m) => Dependency a -> m a
Files
- morpheus-graphql-server.cabal +40/−7
- src/Data/Morpheus/Server/Deriving/Named/EncodeType.hs +3/−3
- src/Data/Morpheus/Server/Deriving/Named/EncodeValue.hs +3/−3
- src/Data/Morpheus/Server/NamedResolvers.hs +67/−37
- src/Data/Morpheus/Server/Resolvers.hs +2/−0
- src/Data/Morpheus/Server/Types.hs +3/−1
- test/Feature/NamedResolvers/API.hs +19/−0
- test/Feature/NamedResolvers/DB.hs +41/−0
- test/Feature/NamedResolvers/Deities.hs +35/−0
- test/Feature/NamedResolvers/DeitiesApp.hs +70/−0
- test/Feature/NamedResolvers/EntitiesApp.hs +82/−0
- test/Feature/NamedResolvers/Realms.hs +35/−0
- test/Feature/NamedResolvers/RealmsApp.hs +81/−0
- test/Feature/NamedResolvers/deities.gql +14/−0
- test/Feature/NamedResolvers/realms.gql +13/−0
- test/Feature/NamedResolvers/tests/deities-ext/query.gql +9/−0
- test/Feature/NamedResolvers/tests/deities-ext/response.json +20/−0
- test/Feature/NamedResolvers/tests/deities/query.gql +6/−0
- test/Feature/NamedResolvers/tests/deities/response.json +14/−0
- test/Feature/NamedResolvers/tests/deity-by-id/query.gql +6/−0
- test/Feature/NamedResolvers/tests/deity-by-id/response.json +8/−0
- test/Feature/NamedResolvers/tests/deity-ext-by-id/query.gql +9/−0
- test/Feature/NamedResolvers/tests/deity-ext-by-id/response.json +9/−0
- test/Feature/NamedResolvers/tests/deity-simple/query.gql +6/−0
- test/Feature/NamedResolvers/tests/deity-simple/response.json +5/−0
- test/Feature/NamedResolvers/tests/entities/query.gql +23/−0
- test/Feature/NamedResolvers/tests/entities/response.json +37/−0
- test/Feature/NamedResolvers/tests/entity-by-id/query.gql +18/−0
- test/Feature/NamedResolvers/tests/entity-by-id/response.json +16/−0
- test/Feature/NamedResolvers/tests/entity-ext-by-id/query.gql +24/−0
- test/Feature/NamedResolvers/tests/entity-ext-by-id/response.json +20/−0
- test/Feature/NamedResolvers/tests/realm-by-id/query.gql +5/−0
- test/Feature/NamedResolvers/tests/realm-by-id/response.json +7/−0
- test/Feature/NamedResolvers/tests/realm-ext-by-id/query.gql +15/−0
- test/Feature/NamedResolvers/tests/realm-ext-by-id/response.json +15/−0
- test/Feature/NamedResolvers/tests/realm-simple/query.gql +5/−0
- test/Feature/NamedResolvers/tests/realm-simple/response.json +5/−0
- test/Feature/NamedResolvers/tests/realms/query.gql +15/−0
- test/Feature/NamedResolvers/tests/realms/response.json +28/−0
- test/Spec.hs +5/−1
morpheus-graphql-server.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: morpheus-graphql-server-version: 0.25.0+version: 0.26.0 synopsis: Morpheus GraphQL description: Build GraphQL APIs with your favourite functional language! category: web, graphql@@ -136,6 +136,20 @@ test/Feature/Input/variables/valueNotProvided/nonNullVariable/query.gql test/Feature/Input/variables/valueNotProvided/nonNullVariableWithDefaultValue/query.gql test/Feature/Input/variables/valueNotProvided/nullableVariable/query.gql+ test/Feature/NamedResolvers/deities.gql+ test/Feature/NamedResolvers/realms.gql+ test/Feature/NamedResolvers/tests/deities-ext/query.gql+ test/Feature/NamedResolvers/tests/deities/query.gql+ test/Feature/NamedResolvers/tests/deity-by-id/query.gql+ test/Feature/NamedResolvers/tests/deity-ext-by-id/query.gql+ test/Feature/NamedResolvers/tests/deity-simple/query.gql+ test/Feature/NamedResolvers/tests/entities/query.gql+ test/Feature/NamedResolvers/tests/entity-by-id/query.gql+ test/Feature/NamedResolvers/tests/entity-ext-by-id/query.gql+ test/Feature/NamedResolvers/tests/realm-by-id/query.gql+ test/Feature/NamedResolvers/tests/realm-ext-by-id/query.gql+ test/Feature/NamedResolvers/tests/realm-simple/query.gql+ test/Feature/NamedResolvers/tests/realms/query.gql test/Feature/Collision/category-collision-fail/response.json test/Feature/Collision/category-collision-success/response.json test/Feature/Collision/name-collision/response.json@@ -268,6 +282,18 @@ test/Feature/Input/variables/valueNotProvided/nonNullVariable/response.json test/Feature/Input/variables/valueNotProvided/nonNullVariableWithDefaultValue/response.json test/Feature/Input/variables/valueNotProvided/nullableVariable/response.json+ test/Feature/NamedResolvers/tests/deities-ext/response.json+ test/Feature/NamedResolvers/tests/deities/response.json+ test/Feature/NamedResolvers/tests/deity-by-id/response.json+ test/Feature/NamedResolvers/tests/deity-ext-by-id/response.json+ test/Feature/NamedResolvers/tests/deity-simple/response.json+ test/Feature/NamedResolvers/tests/entities/response.json+ test/Feature/NamedResolvers/tests/entity-by-id/response.json+ test/Feature/NamedResolvers/tests/entity-ext-by-id/response.json+ test/Feature/NamedResolvers/tests/realm-by-id/response.json+ test/Feature/NamedResolvers/tests/realm-ext-by-id/response.json+ test/Feature/NamedResolvers/tests/realm-simple/response.json+ test/Feature/NamedResolvers/tests/realms/response.json source-repository head type: git@@ -321,8 +347,8 @@ , base >=4.7.0 && <5.0.0 , bytestring >=0.10.4 && <0.12.0 , containers >=0.4.2.1 && <0.7.0- , morpheus-graphql-app >=0.25.0 && <0.26.0- , morpheus-graphql-core >=0.25.0 && <0.26.0+ , morpheus-graphql-app >=0.26.0 && <0.27.0+ , morpheus-graphql-core >=0.26.0 && <0.27.0 , mtl >=2.0.0 && <3.0.0 , relude >=0.3.0 && <2.0.0 , template-haskell >=2.0.0 && <3.0.0@@ -356,6 +382,13 @@ Feature.Input.Objects Feature.Input.Scalars Feature.Input.Variables+ Feature.NamedResolvers.API+ Feature.NamedResolvers.DB+ Feature.NamedResolvers.Deities+ Feature.NamedResolvers.DeitiesApp+ Feature.NamedResolvers.EntitiesApp+ Feature.NamedResolvers.Realms+ Feature.NamedResolvers.RealmsApp Paths_morpheus_graphql_server hs-source-dirs: test@@ -366,11 +399,11 @@ , bytestring >=0.10.4 && <0.12.0 , containers >=0.4.2.1 && <0.7.0 , file-embed >=0.0.10 && <1.0.0- , morpheus-graphql-app >=0.25.0 && <0.26.0- , morpheus-graphql-core >=0.25.0 && <0.26.0+ , morpheus-graphql-app >=0.26.0 && <0.27.0+ , morpheus-graphql-core >=0.26.0 && <0.27.0 , morpheus-graphql-server- , morpheus-graphql-subscriptions >=0.25.0 && <0.26.0- , morpheus-graphql-tests >=0.25.0 && <0.26.0+ , morpheus-graphql-subscriptions >=0.26.0 && <0.27.0+ , morpheus-graphql-tests >=0.26.0 && <0.27.0 , mtl >=2.0.0 && <3.0.0 , relude >=0.3.0 && <2.0.0 , tasty >=0.1.0 && <1.5.0
src/Data/Morpheus/Server/Deriving/Named/EncodeType.hs view
@@ -36,7 +36,7 @@ ) import Data.Morpheus.Server.Deriving.Utils.GTraversable import Data.Morpheus.Server.Deriving.Utils.Kinded (KindedProxy (KindedProxy))-import Data.Morpheus.Server.NamedResolvers (NamedResolverT (..), ResolveNamed (..))+import Data.Morpheus.Server.NamedResolvers (Dependency, NamedResolverT (..), ResolveNamed (..)) import Data.Morpheus.Server.Types.GQLType ( GQLType, KIND,@@ -80,7 +80,7 @@ Generic a, GQLType a, EncodeFieldKind (KIND a) (Resolver o e m) a,- Decode (Dep a),+ Decode (Dependency a), ResolveNamed (Resolver o e m) a, FieldConstraint (Resolver o e m) a ) =>@@ -96,7 +96,7 @@ resolve :: [ValidValue] -> Resolver o e m [Maybe a] resolve xs = traverse decodeArg xs >>= resolveBatched - decodeArg :: ValidValue -> Resolver o e m (Dep a)+ decodeArg :: ValidValue -> Resolver o e m (Dependency a) decodeArg = liftResolverState . decode instance DeriveNamedResolver m (KIND a) a => DeriveNamedResolver m CUSTOM (NamedResolverT m a) where
src/Data/Morpheus/Server/Deriving/Named/EncodeValue.hs view
@@ -57,8 +57,8 @@ ) import Data.Morpheus.Server.Deriving.Utils.Kinded import Data.Morpheus.Server.NamedResolvers- ( NamedResolverT (..),- ResolveNamed (..),+ ( Dependency,+ NamedResolverT (..), ) import Data.Morpheus.Server.Types.GQLType ( GQLType (__type),@@ -131,7 +131,7 @@ ( Monad m, GQLType a, EncodeFieldKind (KIND a) m a,- ToJSON (Dep a)+ ToJSON (Dependency a) ) => EncodeFieldKind CUSTOM m (NamedResolverT m a) where
src/Data/Morpheus/Server/NamedResolvers.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Server.NamedResolvers@@ -13,6 +14,8 @@ NamedResolverT (..), resolve, useBatched,+ Dependency,+ ignoreBatching, ) where @@ -20,61 +23,88 @@ import Data.Aeson (ToJSON) import Data.Morpheus.Types.ID (ID) import Data.Morpheus.Types.Internal.AST (GQLError, internal)+import Data.Vector (Vector)+import GHC.TypeLits (Symbol) import Relude -instance (Monad m) => ResolveNamed m ID where- type Dep ID = ID- resolveNamed = pure+type family Target a :: Type where+ Target (Maybe a) = a+ Target [a] = a+ Target (Set a) = a+ Target (NonEmpty a) = a+ Target (Seq a) = a+ Target (Vector a) = a+ Target a = a -instance Monad m => ResolveNamed m Text where- type Dep Text = Text- resolveNamed = pure+type family Dependency a :: Type where+ -- scalars+ Dependency Int = Int+ Dependency Double = Double+ Dependency Float = Float+ Dependency Text = Text+ Dependency Bool = Bool+ Dependency ID = ID+ -- wrappers+ Dependency (Maybe a) = Dependency a+ Dependency [a] = Dependency a+ Dependency (Set a) = Dependency a+ Dependency (NonEmpty a) = Dependency a+ Dependency (Seq a) = Dependency a+ Dependency (Vector a) = Dependency a+ -- custom+ Dependency a = Dep a -useBatched :: (ResolveNamed m a, MonadError GQLError m) => Dep a -> m a+ignoreBatching :: (Monad m) => (a -> m b) -> [a] -> m [Maybe b]+ignoreBatching f = traverse (fmap Just . f)++{-# DEPRECATED useBatched " this function is obsolete" #-}+useBatched :: (ResolveNamed m a, MonadError GQLError m) => Dependency a -> m a useBatched x = resolveBatched [x] >>= res where res [Just v] = pure v res _ = throwError (internal "named resolver should return single value for single argument") -class (ToJSON (Dep a)) => ResolveNamed (m :: Type -> Type) (a :: Type) where- type Dep a :: Type- resolveBatched :: Monad m => [Dep a] -> m [Maybe a]- resolveBatched = traverse (fmap Just . resolveNamed)-- resolveNamed :: Monad m => Dep a -> m a+{-# DEPRECATED resolveNamed "use: resolveBatched" #-} -instance (ResolveNamed m a, MonadError GQLError m) => ResolveNamed (m :: Type -> Type) [a] where- type Dep [a] = [Dep a]- resolveNamed _ = throwError (internal "named resolver instance [a] should not be called")+class ToJSON (Dependency a) => ResolveNamed (m :: Type -> Type) (a :: Type) where+ type Dep a :: Type+ resolveBatched :: MonadError GQLError m => [Dependency a] -> m [Maybe a] -instance (ResolveNamed m a, MonadError GQLError m) => ResolveNamed (m :: Type -> Type) (Maybe a) where- type Dep (Maybe a) = Maybe (Dep a)- resolveNamed _ = throwError (internal "named resolver instance Maybe should not be called")+ resolveNamed :: MonadError GQLError m => Dependency a -> m a+ resolveNamed = useBatched data NamedResolverT (m :: Type -> Type) a where- Ref :: ResolveNamed m a => m (Dep a) -> NamedResolverT m a- Refs :: ResolveNamed m a => m [Dep a] -> NamedResolverT m [a]+ Ref :: ResolveNamed m (Target a) => m (Dependency a) -> NamedResolverT m a+ Refs :: ResolveNamed m (Target a) => m [Dependency a] -> NamedResolverT m [a] Value :: m a -> NamedResolverT m a --- RESOLVER TYPES-data RES = VALUE | LIST | REF+data TargetType = LIST | SINGLE | ERROR Symbol -type family RES_TYPE a b :: RES where- RES_TYPE a a = 'VALUE- RES_TYPE [a] [b] = 'LIST- RES_TYPE a b = 'REF+type family NamedResolverTarget b :: TargetType where+ NamedResolverTarget [a] = 'LIST+ NamedResolverTarget (Set a) = 'LIST+ NamedResolverTarget (NonEmpty a) = 'LIST+ NamedResolverTarget (Seq a) = 'LIST+ NamedResolverTarget (Vector a) = 'LIST+ NamedResolverTarget Int = 'ERROR "use lift, type Int can't have ResolveNamed instance"+ NamedResolverTarget Double = 'ERROR "use lift, type Double can't have ResolveNamed instance"+ NamedResolverTarget Float = 'ERROR "use lift, type Float can't have ResolveNamed instance"+ NamedResolverTarget Text = 'ERROR "use lift, type Text can't have ResolveNamed instance"+ NamedResolverTarget Bool = 'ERROR "use lift, type Bool can't have ResolveNamed instance"+ NamedResolverTarget ID = 'ERROR "use lift, type ID can't have ResolveNamed instance"+ NamedResolverTarget b = 'SINGLE -resolve :: forall m a b. (ResolveByType (RES_TYPE a b) m a b) => Monad m => m a -> NamedResolverT m b-resolve = resolveByType (Proxy :: Proxy (RES_TYPE a b))+instance MonadTrans NamedResolverT where+ lift = Value -class Dep b ~ a => ResolveByType (k :: RES) m a b where- resolveByType :: Monad m => f k -> m a -> NamedResolverT m b+resolve :: forall m a b. (ResolveRef (NamedResolverTarget b) m a b) => Monad m => m a -> NamedResolverT m b+resolve = resolveRef (Proxy :: Proxy (NamedResolverTarget b)) -instance (ResolveNamed m a, Dep a ~ a) => ResolveByType 'VALUE m a a where- resolveByType _ = Value+class ResolveRef (k :: TargetType) m a b where+ resolveRef :: Monad m => f k -> m a -> NamedResolverT m b -instance (ResolveNamed m b, Dep b ~ a) => ResolveByType 'LIST m [a] [b] where- resolveByType _ = Refs+instance (ResolveNamed m (Target b), a ~ Dependency b) => ResolveRef 'LIST m [a] [b] where+ resolveRef _ = Refs -instance (ResolveNamed m b, Dep b ~ a) => ResolveByType 'REF m a b where- resolveByType _ = Ref+instance (ResolveNamed m (Target b), Dependency b ~ a) => ResolveRef 'SINGLE m a b where+ resolveRef _ = Ref
src/Data/Morpheus/Server/Resolvers.hs view
@@ -24,6 +24,7 @@ ResolverM, ResolverS, useBatched,+ ignoreBatching, ) where @@ -31,6 +32,7 @@ import Data.Morpheus.Server.NamedResolvers ( NamedResolverT (..), ResolveNamed (..),+ ignoreBatching, resolve, useBatched, )
src/Data/Morpheus/Server/Types.hs view
@@ -35,6 +35,7 @@ render, TypeGuard (..), Arg (..),+ GQLError, -- * GQL directives API Prefixes (..),@@ -134,7 +135,8 @@ GQLResponse (..), ) import Data.Morpheus.Types.Internal.AST- ( MUTATION,+ ( GQLError,+ MUTATION, QUERY, SUBSCRIPTION, ScalarValue (..),
+ test/Feature/NamedResolvers/API.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Feature.NamedResolvers.API+ ( api,+ )+where++import Data.Morpheus.Server (App, runApp)+import Data.Morpheus.Server.Types (GQLRequest, GQLResponse)+import Feature.NamedResolvers.DeitiesApp (deitiesApp)+import Feature.NamedResolvers.EntitiesApp (entitiesApp)+import Feature.NamedResolvers.RealmsApp (realmsApp)+import Relude++app :: App () IO+app = deitiesApp <> realmsApp <> entitiesApp++api :: GQLRequest -> IO GQLResponse+api = runApp app
+ test/Feature/NamedResolvers/DB.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Feature.NamedResolvers.DB where++import Data.Morpheus.Server.Types (ID (..))+import Relude++allDeities :: [ID]+allDeities = ["zeus", "morpheus"]++allRealms :: [ID]+allRealms = ["olympus", "dreams"]++allEntities :: [ID]+allEntities = ["zeus", "morpheus", "olympus", "dreams"]++getPowers :: (Monad m) => ID -> m [ID]+getPowers "zeus" = pure ["tb"]+getPowers "morpheus" = pure ["sp"]+getPowers _ = pure []++getDeityName :: (Monad m) => ID -> m Text+getDeityName "zeus" = pure "Zeus"+getDeityName "morpheus" = pure "Morpheus"+getDeityName _ = pure ""++getRealmName :: (Monad m) => ID -> m Text+getRealmName "olympus" = pure "Mount Olympus"+getRealmName "dreams" = pure "Fictional world of dreams"+getRealmName _ = pure ""++getOwner :: (Monad m) => ID -> m ID+getOwner "olympus" = pure "zeus"+getOwner "dreams" = pure "morpheus"+getOwner _ = pure ""++getPlace :: (Monad m) => ID -> m ID+getPlace "zeus" = pure "olympus"+getPlace "morpheus" = pure "dreams"+getPlace x = pure x
+ test/Feature/NamedResolvers/Deities.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TypeFamilies #-}++module Feature.NamedResolvers.Deities where++import Data.Morpheus.Server.CodeGen.Internal+import Data.Morpheus.Server.Types++data Power+ = Shapeshifting+ | Thunderbolt+ deriving (Generic, Show)++instance GQLType Power where+ type KIND Power = TYPE++data Deity m = Deity+ { name :: m Text,+ power :: m [Power]+ }+ deriving (Generic)++instance (Typeable m) => GQLType (Deity m) where+ type KIND (Deity m) = TYPE++data Query m = Query+ { deities :: m [Deity m],+ deity :: Arg "id" ID -> m (Maybe (Deity m))+ }+ deriving (Generic)++instance (Typeable m) => GQLType (Query m) where+ type KIND (Query m) = TYPE
+ test/Feature/NamedResolvers/DeitiesApp.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Feature.NamedResolvers.DeitiesApp+ ( deitiesApp,+ )+where++import Control.Monad.Except+import Data.Morpheus.Server (deriveApp)+import Data.Morpheus.Server.Resolvers+ ( NamedResolverT,+ NamedResolvers (..),+ ResolveNamed (..),+ ignoreBatching,+ resolve,+ )+import Data.Morpheus.Server.Types+ ( App,+ Arg (..),+ ID,+ Undefined,+ )+import Feature.NamedResolvers.DB (allDeities, getDeityName, getPowers)+import Feature.NamedResolvers.Deities+import Relude hiding (Undefined)++getPower :: (Monad m) => ID -> m (Maybe Power)+getPower "sp" = pure (Just Shapeshifting)+getPower "tb" = pure (Just Thunderbolt)+getPower _ = pure Nothing++getDeity :: Monad m => ID -> m (Maybe (Deity (NamedResolverT m)))+getDeity uid+ | uid `elem` allDeities =+ pure $+ Just+ Deity+ { name = lift (getDeityName uid),+ power = resolve (getPowers uid)+ }+getDeity _ = pure Nothing++instance ResolveNamed m Power where+ type Dep Power = ID+ resolveBatched = traverse getPower++instance ResolveNamed m (Deity (NamedResolverT m)) where+ type Dep (Deity (NamedResolverT m)) = ID+ resolveBatched = traverse getDeity++instance ResolveNamed m (Query (NamedResolverT m)) where+ type Dep (Query (NamedResolverT m)) = ()+ resolveBatched =+ ignoreBatching $+ const $+ pure+ Query+ { deity = \(Arg uid) -> resolve (pure uid),+ deities = resolve (pure allDeities)+ }++deitiesApp :: App () IO+deitiesApp = deriveApp (NamedResolvers :: NamedResolvers IO () Query Undefined Undefined)
+ test/Feature/NamedResolvers/EntitiesApp.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Feature.NamedResolvers.EntitiesApp+ ( entitiesApp,+ )+where++import Control.Monad.Except+import Data.Morpheus.Server (deriveApp)+import Data.Morpheus.Server.Resolvers+ ( NamedResolverT,+ NamedResolvers (..),+ ResolveNamed (..),+ ignoreBatching,+ resolve,+ )+import Data.Morpheus.Server.Types+ ( App,+ Arg (..),+ GQLError,+ GQLType (..),+ ID,+ Undefined,+ )+import Feature.NamedResolvers.DB+ ( allDeities,+ allEntities,+ )+import Feature.NamedResolvers.RealmsApp (Deity, Realm)+import GHC.Generics (Generic)++-- Entity+data Entity m+ = EntityDeity (m (Deity m))+ | EntityRealm (m (Realm m))+ deriving+ ( Generic,+ GQLType+ )++getEntity :: (MonadError GQLError m) => ID -> m (Entity (NamedResolverT m))+getEntity name | name `elem` allDeities = pure $ EntityDeity $ resolve $ pure name+getEntity x = pure $ EntityRealm $ resolve $ pure x++instance ResolveNamed m (Entity (NamedResolverT m)) where+ type Dep (Entity (NamedResolverT m)) = ID+ resolveBatched = ignoreBatching getEntity++-- QUERY+data Query m = Query+ { entities :: m [Entity m],+ entity :: Arg "id" ID -> m (Maybe (Entity m))+ }+ deriving+ ( Generic,+ GQLType+ )++instance ResolveNamed m (Query (NamedResolverT m)) where+ type Dep (Query (NamedResolverT m)) = ()+ resolveBatched =+ ignoreBatching $+ const $+ pure+ Query+ { entities = resolve (pure allEntities),+ entity = \(Arg uid) -> resolve (pure uid)+ }++entitiesApp :: App () IO+entitiesApp =+ deriveApp+ ( NamedResolvers ::+ NamedResolvers IO () Query Undefined Undefined+ )
+ test/Feature/NamedResolvers/Realms.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TypeFamilies #-}++module Feature.NamedResolvers.Realms where++import Data.Morpheus.Server.CodeGen.Internal+import Data.Morpheus.Server.Types++data Realm m = Realm+ { name :: m Text,+ owner :: m (Deity m)+ }+ deriving (Generic)++instance (Typeable m) => GQLType (Realm m) where+ type KIND (Realm m) = TYPE++newtype Deity m = Deity+ { realm :: m (Realm m)+ }+ deriving (Generic)++instance (Typeable m) => GQLType (Deity m) where+ type KIND (Deity m) = TYPE++data Query m = Query+ { realms :: m [Realm m],+ realm :: Arg "id" ID -> m (Maybe (Realm m))+ }+ deriving (Generic)++instance (Typeable m) => GQLType (Query m) where+ type KIND (Query m) = TYPE
+ test/Feature/NamedResolvers/RealmsApp.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Feature.NamedResolvers.RealmsApp+ ( realmsApp,+ Deity,+ Realm,+ )+where++import Control.Monad.Except+import Data.Morpheus.Server+ ( deriveApp,+ )+import Data.Morpheus.Server.Resolvers+ ( NamedResolverT,+ NamedResolvers (..),+ ResolveNamed (..),+ ignoreBatching,+ resolve,+ )+import Data.Morpheus.Server.Types+ ( App,+ Arg (..),+ ID,+ Undefined,+ )+import Feature.NamedResolvers.DB+ ( allDeities,+ allRealms,+ getOwner,+ getPlace,+ getRealmName,+ )+import Feature.NamedResolvers.Realms++getRealm :: (Monad m) => ID -> m (Maybe (Realm (NamedResolverT m)))+getRealm uid+ | uid `elem` allRealms =+ pure $+ Just+ Realm+ { name = lift (getRealmName uid),+ owner = resolve (getOwner uid)+ }+getRealm _ = pure Nothing++instance ResolveNamed m (Realm (NamedResolverT m)) where+ type Dep (Realm (NamedResolverT m)) = ID++ resolveBatched = traverse getRealm++instance ResolveNamed m (Deity (NamedResolverT m)) where+ type Dep (Deity (NamedResolverT m)) = ID+ resolveBatched = traverse getDeity++getDeity :: (Monad m) => ID -> m (Maybe (Deity (NamedResolverT m)))+getDeity arg+ | arg `elem` allDeities = pure $ Just Deity {realm = resolve (getPlace arg)}+ | otherwise = pure Nothing++instance ResolveNamed m (Query (NamedResolverT m)) where+ type Dep (Query (NamedResolverT m)) = ()+ resolveBatched =+ ignoreBatching $+ const $+ pure+ Query+ { realm = \(Arg arg) -> resolve (pure arg),+ realms = resolve (pure allRealms)+ }++realmsApp :: App () IO+realmsApp =+ deriveApp+ (NamedResolvers :: NamedResolvers IO () Query Undefined Undefined)
+ test/Feature/NamedResolvers/deities.gql view
@@ -0,0 +1,14 @@+enum Power {+ Shapeshifting+ Thunderbolt+}++type Deity {+ name: String!+ power: [Power!]!+}++type Query {+ deities: [Deity!]!+ deity(id: ID!): Deity+}
+ test/Feature/NamedResolvers/realms.gql view
@@ -0,0 +1,13 @@+type Realm {+ name: String!+ owner: Deity!+}++type Deity {+ realm: Realm!+}++type Query {+ realms: [Realm!]!+ realm(id: ID!): Realm+}
+ test/Feature/NamedResolvers/tests/deities-ext/query.gql view
@@ -0,0 +1,9 @@+query {+ deities {+ name+ power+ realm {+ name+ }+ }+}
+ test/Feature/NamedResolvers/tests/deities-ext/response.json view
@@ -0,0 +1,20 @@+{+ "data": {+ "deities": [+ {+ "name": "Zeus",+ "realm": {+ "name": "Mount Olympus"+ },+ "power": ["Thunderbolt"]+ },+ {+ "name": "Morpheus",+ "realm": {+ "name": "Fictional world of dreams"+ },+ "power": ["Shapeshifting"]+ }+ ]+ }+}
+ test/Feature/NamedResolvers/tests/deities/query.gql view
@@ -0,0 +1,6 @@+query {+ deities {+ name+ power+ }+}
+ test/Feature/NamedResolvers/tests/deities/response.json view
@@ -0,0 +1,14 @@+{+ "data": {+ "deities": [+ {+ "name": "Zeus",+ "power": ["Thunderbolt"]+ },+ {+ "name": "Morpheus",+ "power": ["Shapeshifting"]+ }+ ]+ }+}
+ test/Feature/NamedResolvers/tests/deity-by-id/query.gql view
@@ -0,0 +1,6 @@+query {+ deity(id: "zeus") {+ name+ power+ }+}
+ test/Feature/NamedResolvers/tests/deity-by-id/response.json view
@@ -0,0 +1,8 @@+{+ "data": {+ "deity": {+ "name": "Zeus",+ "power": ["Thunderbolt"]+ }+ }+}
+ test/Feature/NamedResolvers/tests/deity-ext-by-id/query.gql view
@@ -0,0 +1,9 @@+query {+ deity(id: "zeus") {+ name+ power+ realm {+ name+ }+ }+}
+ test/Feature/NamedResolvers/tests/deity-ext-by-id/response.json view
@@ -0,0 +1,9 @@+{+ "data": {+ "deity": {+ "name": "Zeus",+ "realm": { "name": "Mount Olympus" },+ "power": ["Thunderbolt"]+ }+ }+}
+ test/Feature/NamedResolvers/tests/deity-simple/query.gql view
@@ -0,0 +1,6 @@+query {+ deity(id: "") {+ name+ power+ }+}
+ test/Feature/NamedResolvers/tests/deity-simple/response.json view
@@ -0,0 +1,5 @@+{+ "data": {+ "deity": null+ }+}
+ test/Feature/NamedResolvers/tests/entities/query.gql view
@@ -0,0 +1,23 @@+query {+ entities {+ ... on Realm {+ __typename+ name+ owner {+ name+ power+ realm {+ name+ owner {+ name+ }+ }+ }+ }+ ... on Deity {+ __typename+ name+ power+ }+ }+}
+ test/Feature/NamedResolvers/tests/entities/response.json view
@@ -0,0 +1,37 @@+{+ "data": {+ "entities": [+ {+ "name": "Zeus",+ "__typename": "Deity",+ "power": ["Thunderbolt"]+ },+ {+ "name": "Morpheus",+ "__typename": "Deity",+ "power": ["Shapeshifting"]+ },+ {+ "owner": {+ "name": "Zeus",+ "realm": { "owner": { "name": "Zeus" }, "name": "Mount Olympus" },+ "power": ["Thunderbolt"]+ },+ "name": "Mount Olympus",+ "__typename": "Realm"+ },+ {+ "owner": {+ "name": "Morpheus",+ "realm": {+ "owner": { "name": "Morpheus" },+ "name": "Fictional world of dreams"+ },+ "power": ["Shapeshifting"]+ },+ "name": "Fictional world of dreams",+ "__typename": "Realm"+ }+ ]+ }+}
+ test/Feature/NamedResolvers/tests/entity-by-id/query.gql view
@@ -0,0 +1,18 @@+query {+ zeus: entity(id: "zeus") {+ __typename+ ... on Deity {+ name+ power+ }+ }+ olympus: entity(id: "olympus") {+ __typename+ ... on Realm {+ name+ owner {+ name+ }+ }+ }+}
+ test/Feature/NamedResolvers/tests/entity-by-id/response.json view
@@ -0,0 +1,16 @@+{+ "data": {+ "zeus": {+ "__typename": "Deity",+ "name": "Zeus",+ "power": ["Thunderbolt"]+ },+ "olympus": {+ "__typename": "Realm",+ "name": "Mount Olympus",+ "owner": {+ "name": "Zeus"+ }+ }+ }+}
+ test/Feature/NamedResolvers/tests/entity-ext-by-id/query.gql view
@@ -0,0 +1,24 @@+query {+ zeus: entity(id: "zeus") {+ ... on Deity {+ __typename+ name+ power+ }+ }+ olympus: entity(id: "olympus") {+ ... on Realm {+ name+ owner {+ name+ power+ realm {+ name+ owner {+ name+ }+ }+ }+ }+ }+}
+ test/Feature/NamedResolvers/tests/entity-ext-by-id/response.json view
@@ -0,0 +1,20 @@+{+ "data": {+ "zeus": {+ "__typename": "Deity",+ "name": "Zeus",+ "power": ["Thunderbolt"]+ },+ "olympus": {+ "name": "Mount Olympus",+ "owner": {+ "name": "Zeus",+ "realm": {+ "name": "Mount Olympus",+ "owner": { "name": "Zeus" }+ },+ "power": ["Thunderbolt"]+ }+ }+ }+}
+ test/Feature/NamedResolvers/tests/realm-by-id/query.gql view
@@ -0,0 +1,5 @@+query {+ realm(id: "olympus") {+ name+ }+}
+ test/Feature/NamedResolvers/tests/realm-by-id/response.json view
@@ -0,0 +1,7 @@+{+ "data": {+ "realm": {+ "name": "Mount Olympus"+ }+ }+}
+ test/Feature/NamedResolvers/tests/realm-ext-by-id/query.gql view
@@ -0,0 +1,15 @@+query {+ realm(id: "olympus") {+ name+ owner {+ name+ power+ realm {+ name+ owner {+ name+ }+ }+ }+ }+}
+ test/Feature/NamedResolvers/tests/realm-ext-by-id/response.json view
@@ -0,0 +1,15 @@+{+ "data": {+ "realm": {+ "owner": {+ "name": "Zeus",+ "realm": {+ "owner": { "name": "Zeus" },+ "name": "Mount Olympus"+ },+ "power": ["Thunderbolt"]+ },+ "name": "Mount Olympus"+ }+ }+}
+ test/Feature/NamedResolvers/tests/realm-simple/query.gql view
@@ -0,0 +1,5 @@+query {+ realm(id: "") {+ name+ }+}
+ test/Feature/NamedResolvers/tests/realm-simple/response.json view
@@ -0,0 +1,5 @@+{+ "data": {+ "realm": null+ }+}
+ test/Feature/NamedResolvers/tests/realms/query.gql view
@@ -0,0 +1,15 @@+query {+ realms {+ name+ owner {+ name+ power+ realm {+ name+ owner {+ name+ }+ }+ }+ }+}
+ test/Feature/NamedResolvers/tests/realms/response.json view
@@ -0,0 +1,28 @@+{+ "data": {+ "realms": [+ {+ "owner": {+ "name": "Zeus",+ "realm": {+ "owner": { "name": "Zeus" },+ "name": "Mount Olympus"+ },+ "power": ["Thunderbolt"]+ },+ "name": "Mount Olympus"+ },+ {+ "owner": {+ "name": "Morpheus",+ "realm": {+ "owner": { "name": "Morpheus" },+ "name": "Fictional world of dreams"+ },+ "power": ["Shapeshifting"]+ },+ "name": "Fictional world of dreams"+ }+ ]+ }+}
test/Spec.hs view
@@ -26,6 +26,7 @@ import qualified Feature.Input.Objects as Objects import qualified Feature.Input.Scalars as Scalars import qualified Feature.Input.Variables as Variables+import qualified Feature.NamedResolvers.API as NamedResolvers import Relude import Test.Morpheus ( FileUrl,@@ -87,5 +88,8 @@ (EnumVisitor.api, "enum-visitor"), (FieldVisitor.api, "field-visitor"), (TypeVisitor.api, "type-visitor")- ]+ ],+ testFeatures+ "NamedResolvers"+ [(NamedResolvers.api, "tests")] ]