Morpheus Graphql — Named Resolvers with custom Resolution Context

I am trying to use the morpheus-graphql package but I am stuck. I would like to use »Named Resolvers« in combination with a custom Resolver Context / Resolver Monad.

Here is the module for the Resolution Context (src/Ctx.hs)

module Ctx where


import Data.Text (Text)
import Control.Monad.Reader (ReaderT (runReaderT), MonadReader, MonadIO, runReaderT)
import Control.Monad.Except (ExceptT, MonadError (..), runExceptT)
import Data.Morpheus.Types (GQLError)

type Deps = Text -- represents the database connection
type Fail = GQLError

class (Monad m, MonadError GQLError m, MonadIO m, MonadReader Deps m) => MonadCtx m

newtype Ctx a = App { runCtx :: ReaderT Deps (ExceptT Fail IO) a } 
  deriving (Functor, Applicative, Monad,
            MonadReader Deps,
            MonadError Fail,
            MonadIO,
            MonadCtx)

So the Ctx allows the injection of the Database dependency and IO in general

Here is src/User.hs which follows this example:

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses#-}
{-# LANGUAGE FlexibleContexts #-}

module User where

import Prelude hiding (id)

import Data.Text (Text)
import qualified Ctx as Ctx
import GHC.Generics (Generic)
import Control.Monad.Reader (ask, MonadIO (liftIO))

import Data.Morpheus.Types (
  GQLType,
  ID (unpackID),
  Arg(..),
  NamedResolvers (..),
  Undefined)

import Data.Morpheus.NamedResolvers (
  NamedResolverT (NamedResolverT),
  ResolveNamed (Dep, resolveBatched),
  resolve
  )


data User m = User {
    id :: m Text
  , name :: m Text
} deriving (Generic, GQLType)


getUsr :: (Ctx.MonadCtx m) => ID -> m (Maybe (User (NamedResolverT m)))
getUsr uid = do
  deps <- ask
  _ <- liftIO  getChar
  pure $ Just $ User { 
    id = resolve $ pure "", 
    name = resolve $ pure $ "Deps:" <> deps <> ", id: " <> unpackID uid }


instance (Ctx.MonadCtx m) => ResolveNamed m (Usr (NamedResolverT m)) where
  type Dep (User (NamedResolverT m)) = ID
  resolveBatched = traverse getUser


data Query m = Query {
    users :: m [User m]
  , user :: Arg "id" ID -> m (Maybe (User m))
  }
  deriving(Generic, GQLType)

instance (Ctx.MonadCtx m) => ResolveNamed m (Query (NamedResolverT m)) where
  type Dep (Query (NamedResolverT m)) = ()
  resolveBatched = undefined


rootResolver :: (Ctx.MonadCtx m) => NamedResolvers m () Query Undefined Undefined
rootResolver = NamedResolvers

But that doesn’t compile and the message doesn’t tell me too much.

• Couldn't match type ‘morpheus-graphql-app-0.27.0:Data.Morpheus.App.Internal.Resolving.ResolverState.ResolverContext’
                 with ‘Text’
    arising from a functional dependency between:
      constraint ‘Control.Monad.Reader.Class.MonadReader
                    App.Deps
                    (morpheus-graphql-app-0.27.0:Data.Morpheus.App.Internal.Resolving.Resolver.Resolver
                       morpheus-graphql-core-0.27.0:Data.Morpheus.Types.Internal.AST.OperationType.QUERY
                       ()
                       m)’
        arising from a use of ‘NamedResolvers’
      instance ‘Control.Monad.Reader.Class.MonadReader
                  morpheus-graphql-app-0.27.0:Data.Morpheus.App.Internal.Resolving.ResolverState.ResolverContext
                  (morpheus-graphql-app-0.27.0:Data.Morpheus.App.Internal.Resolving.Resolver.Resolver
                     o e m1)’
        at <no location info>
• In the expression: NamedResolvers
  In an equation for ‘rootResolver’: rootResolver = NamedResolverstypecheck(-Wdeferred-type-errors)

Any Ideas how to properly use a custom Context and Named Resolvers together?

Thanks for Help!!

1 Like