{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Types.NamedResolvers
( ResolveNamed (..),
NamedResolverT (..),
resolve,
useBatched,
Dependency,
ignoreBatching,
NamedRef,
)
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 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 (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 = (a -> m (Maybe b)) -> [a] -> m [Maybe b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((b -> Maybe b) -> m b -> m (Maybe b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just (m b -> m (Maybe b)) -> (a -> m b) -> a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)
forward :: (Monad m, Dependency a ~ a) => [Dependency a] -> m [Maybe a]
forward :: forall (m :: * -> *) a.
(Monad m, Dependency a ~ a) =>
[Dependency a] -> m [Maybe a]
forward = [Maybe a] -> m [Maybe a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Maybe a] -> m [Maybe a])
-> ([a] -> [Maybe a]) -> [a] -> m [Maybe a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just
{-# 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 = [Dependency a] -> m [Maybe a]
forall (m :: * -> *) a.
(ResolveNamed m a, MonadError GQLError m) =>
[Dependency a] -> m [Maybe a]
resolveBatched [Dependency a
x] m [Maybe a] -> ([Maybe a] -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Maybe a] -> m a
forall {f :: * -> *} {a}. MonadError GQLError f => [Maybe a] -> f a
res
where
res :: [Maybe a] -> f a
res [Just a
v] = a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
res [Maybe a]
_ = GQLError -> f a
forall a. GQLError -> f 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" #-}
instance ResolveNamed m Int where
type Dep Int = Int
resolveBatched :: MonadError GQLError m => [Dependency Int] -> m [Maybe Int]
resolveBatched = [Dependency Int] -> m [Maybe Int]
forall (m :: * -> *) a.
(Monad m, Dependency a ~ a) =>
[Dependency a] -> m [Maybe a]
forward
instance ResolveNamed m Float where
type Dep Float = Float
resolveBatched :: MonadError GQLError m => [Dependency Float] -> m [Maybe Float]
resolveBatched = [Dependency Float] -> m [Maybe Float]
forall (m :: * -> *) a.
(Monad m, Dependency a ~ a) =>
[Dependency a] -> m [Maybe a]
forward
instance ResolveNamed m Double where
type Dep Double = Double
resolveBatched :: MonadError GQLError m => [Dependency Double] -> m [Maybe Double]
resolveBatched = [Dependency Double] -> m [Maybe Double]
forall (m :: * -> *) a.
(Monad m, Dependency a ~ a) =>
[Dependency a] -> m [Maybe a]
forward
instance ResolveNamed m Text where
type Dep Text = Text
resolveBatched :: MonadError GQLError m => [Dependency Text] -> m [Maybe Text]
resolveBatched = [Dependency Text] -> m [Maybe Text]
forall (m :: * -> *) a.
(Monad m, Dependency a ~ a) =>
[Dependency a] -> m [Maybe a]
forward
instance ResolveNamed m Bool where
type Dep Bool = Bool
resolveBatched :: MonadError GQLError m => [Dependency Bool] -> m [Maybe Bool]
resolveBatched = [Dependency Bool] -> m [Maybe Bool]
forall (m :: * -> *) a.
(Monad m, Dependency a ~ a) =>
[Dependency a] -> m [Maybe a]
forward
instance ResolveNamed m ID where
type Dep ID = ID
resolveBatched :: MonadError GQLError m => [Dependency ID] -> m [Maybe ID]
resolveBatched = [Dependency ID] -> m [Maybe ID]
forall (m :: * -> *) a.
(Monad m, Dependency a ~ a) =>
[Dependency a] -> m [Maybe a]
forward
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 = Dependency a -> m a
forall (m :: * -> *) a.
(ResolveNamed m a, MonadError GQLError m) =>
Dependency a -> m a
useBatched
data NamedResolverT (m :: Type -> Type) a where
NamedResolverT :: (ResolveNamed m (Target a)) => m (NamedRef a) -> NamedResolverT m a
type family NamedRef a :: Type where
NamedRef [a] = [Dependency a]
NamedRef (Set a) = [Dependency a]
NamedRef (NonEmpty a) = [Dependency a]
NamedRef (Seq a) = [Dependency a]
NamedRef (Vector a) = [Dependency a]
NamedRef a = Dependency a
resolve :: (ResolveNamed m (Target a)) => m (NamedRef a) -> NamedResolverT m a
resolve :: forall (m :: * -> *) a.
ResolveNamed m (Target a) =>
m (NamedRef a) -> NamedResolverT m a
resolve = m (NamedRef a) -> NamedResolverT m a
forall (m :: * -> *) a.
ResolveNamed m (Target a) =>
m (NamedRef a) -> NamedResolverT m a
NamedResolverT