{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.NamedResolvers
( ResolveNamed (..),
NamedResolverT (..),
resolve,
useBatched,
Dependency,
ignoreBatching,
)
where
import Control.Monad.Except
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
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
type family Dependency a :: Type where
Dependency Int = Int
Dependency Double = Double
Dependency Float = Float
Dependency Text = Text
Dependency Bool = Bool
Dependency ID = ID
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
Dependency a = Dep a
ignoreBatching :: (Monad m) => (a -> m b) -> [a] -> m [Maybe b]
ignoreBatching :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> [a] -> m [Maybe b]
ignoreBatching a -> m b
f = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)
{-# DEPRECATED useBatched " this function is obsolete" #-}
useBatched :: (ResolveNamed m a, MonadError GQLError m) => Dependency a -> m a
useBatched :: forall (m :: * -> *) a.
(ResolveNamed m a, MonadError GQLError m) =>
Dependency a -> m a
useBatched Dependency a
x = forall (m :: * -> *) a.
(ResolveNamed m a, MonadError GQLError m) =>
[Dependency a] -> m [Maybe a]
resolveBatched [Dependency a
x] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {f :: * -> *} {a}. MonadError GQLError f => [Maybe a] -> f a
res
where
res :: [Maybe a] -> f a
res [Just a
v] = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
res [Maybe a]
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"named resolver should return single value for single argument")
{-# DEPRECATED resolveNamed "use: resolveBatched" #-}
class ToJSON (Dependency a) => ResolveNamed (m :: Type -> Type) (a :: Type) where
type Dep a :: Type
resolveBatched :: MonadError GQLError m => [Dependency a] -> m [Maybe a]
resolveNamed :: MonadError GQLError m => Dependency a -> m a
resolveNamed = forall (m :: * -> *) a.
(ResolveNamed m a, MonadError GQLError m) =>
Dependency a -> m a
useBatched
data NamedResolverT (m :: Type -> Type) a where
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
data TargetType = LIST | SINGLE | ERROR Symbol
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
instance MonadTrans NamedResolverT where
lift :: forall (m :: * -> *) a. Monad m => m a -> NamedResolverT m a
lift = forall (m :: * -> *) a. m a -> NamedResolverT m a
Value
resolve :: forall m a b. (ResolveRef (NamedResolverTarget b) m a b) => Monad m => m a -> NamedResolverT m b
resolve :: forall (m :: * -> *) a b.
(ResolveRef (NamedResolverTarget b) m a b, Monad m) =>
m a -> NamedResolverT m b
resolve = forall (k :: TargetType) (m :: * -> *) a b (f :: TargetType -> *).
(ResolveRef k m a b, Monad m) =>
f k -> m a -> NamedResolverT m b
resolveRef (forall {k} (t :: k). Proxy t
Proxy :: Proxy (NamedResolverTarget b))
class ResolveRef (k :: TargetType) m a b where
resolveRef :: Monad m => f k -> m a -> NamedResolverT m b
instance (ResolveNamed m (Target b), a ~ Dependency b) => ResolveRef 'LIST m [a] [b] where
resolveRef :: forall (f :: TargetType -> *).
Monad m =>
f 'LIST -> m [a] -> NamedResolverT m [b]
resolveRef f 'LIST
_ = forall (m :: * -> *) a.
ResolveNamed m (Target a) =>
m [Dependency a] -> NamedResolverT m [a]
Refs
instance (ResolveNamed m (Target b), Dependency b ~ a) => ResolveRef 'SINGLE m a b where
resolveRef :: forall (f :: TargetType -> *).
Monad m =>
f 'SINGLE -> m a -> NamedResolverT m b
resolveRef f 'SINGLE
_ = forall (m :: * -> *) a.
ResolveNamed m (Target a) =>
m (Dependency a) -> NamedResolverT m a
Ref