{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} module Feature.NamedResolvers.Entities ( entitiesApp, ) where import Control.Monad.Except import Data.Morpheus (deriveApp) import Data.Morpheus.NamedResolvers ( NamedResolverT, ResolveNamed (..), resolve, ) import Data.Morpheus.Types ( App, Arg (..), GQLError, GQLType (..), ID, NamedResolvers (..), Undefined, ) import Feature.NamedResolvers.Realms (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 "zeus" = pure $ EntityDeity (resolve $ pure "zeus") getEntity "morpheus" = pure $ EntityDeity (resolve $ pure "morpheus") getEntity x = pure $ EntityRealm (resolve $ pure x) instance (MonadError GQLError m) => ResolveNamed m (Entity (NamedResolverT m)) where type Dep (Entity (NamedResolverT m)) = ID resolveNamed = getEntity -- QUERY data Query m = Query { entities :: m [Entity m], entity :: Arg "id" ID -> m (Maybe (Entity m)) } deriving ( Generic, GQLType ) instance MonadError GQLError m => ResolveNamed m (Query (NamedResolverT m)) where type Dep (Query (NamedResolverT m)) = () resolveNamed _ = pure Query { entities = resolve (pure ["zeus", "morpheus", "olympus", "dreams"]), entity = \(Arg uid) -> resolve (pure (Just uid)) } entitiesApp :: App () IO entitiesApp = deriveApp ( NamedResolvers :: NamedResolvers IO () Query Undefined Undefined )