{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.App.Internal.Resolving.Batching
  ( ResolverMapT (..),
    SelectionRef,
    runBatchedT,
    MonadBatching (..),
  )
where

import Control.Monad.Except (MonadError (throwError))
import Data.ByteString.Lazy.Char8 (unpack)
import Data.HashMap.Lazy (keys)
import Data.Morpheus.App.Internal.Resolving.Cache
  ( CacheKey (..),
    CacheT,
    CacheValue (..),
    cacheResolverValues,
    cacheValue,
    isCached,
    printSelectionKey,
    useCached,
    withDebug,
  )
import Data.Morpheus.App.Internal.Resolving.Refs (scanRefs)
import Data.Morpheus.App.Internal.Resolving.ResolverState (ResolverContext)
import Data.Morpheus.App.Internal.Resolving.Types
  ( NamedResolver (..),
    NamedResolverResult (..),
    ResolverMap,
  )
import Data.Morpheus.App.Internal.Resolving.Utils
  ( NamedResolverRef (..),
    ResolverMonad,
    ResolverValue (ResEnum, ResNull, ResObject, ResRef, ResScalar),
  )
import Data.Morpheus.Core (render)
import Data.Morpheus.Internal.Utils (Empty (empty), IsMap (..), selectOr)
import Data.Morpheus.Types.Internal.AST
  ( GQLError,
    Msg (..),
    SelectionContent,
    TypeName,
    VALID,
    ValidValue,
    internal,
  )
import GHC.Show (Show (show))
import Relude hiding (empty, show)

data BatchEntry = BatchEntry
  { BatchEntry -> SelectionContent VALID
batchedSelection :: SelectionContent VALID,
    BatchEntry -> TypeName
batchedType :: TypeName,
    BatchEntry -> [ValidValue]
batchedArguments :: [ValidValue]
  }

instance Show BatchEntry where
  show :: BatchEntry -> String
show BatchEntry {[ValidValue]
SelectionContent VALID
TypeName
batchedArguments :: [ValidValue]
batchedType :: TypeName
batchedSelection :: SelectionContent VALID
batchedArguments :: BatchEntry -> [ValidValue]
batchedType :: BatchEntry -> TypeName
batchedSelection :: BatchEntry -> SelectionContent VALID
..} =
    String
"\nBATCH("
      forall a. Semigroup a => a -> a -> a
<> forall a. ToString a => a -> String
toString TypeName
batchedType
      forall a. Semigroup a => a -> a -> a
<> String
"):"
      forall a. Semigroup a => a -> a -> a
<> String
"\n  sel:"
      forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> String
printSelectionKey SelectionContent VALID
batchedSelection
      forall a. Semigroup a => a -> a -> a
<> String
"\n  dep:"
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RenderGQL a => a -> ByteString
render) [ValidValue]
batchedArguments)

type SelectionRef = (SelectionContent VALID, NamedResolverRef)

uniq :: (Eq a, Hashable a) => [a] -> [a]
uniq :: forall a. (Eq a, Hashable a) => [a] -> [a]
uniq = forall k v. HashMap k v -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (,Bool
True)

buildBatches :: [SelectionRef] -> [BatchEntry]
buildBatches :: [SelectionRef] -> [BatchEntry]
buildBatches [SelectionRef]
inputs =
  let entityTypes :: [(SelectionContent VALID, TypeName)]
entityTypes = forall a. (Eq a, Hashable a) => [a] -> [a]
uniq forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second NamedResolverRef -> TypeName
resolverTypeName) [SelectionRef]
inputs
   in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([SelectionRef]
-> (SelectionContent VALID, TypeName) -> Maybe BatchEntry
selectByEntity [SelectionRef]
inputs) [(SelectionContent VALID, TypeName)]
entityTypes

selectByEntity :: [SelectionRef] -> (SelectionContent VALID, TypeName) -> Maybe BatchEntry
selectByEntity :: [SelectionRef]
-> (SelectionContent VALID, TypeName) -> Maybe BatchEntry
selectByEntity [SelectionRef]
inputs (SelectionContent VALID
tSel, TypeName
tName) = case forall {a}. [(a, NamedResolverRef)] -> [ValidValue]
gerArgs (forall a. (a -> Bool) -> [a] -> [a]
filter SelectionRef -> Bool
areEq [SelectionRef]
inputs) of
  [] -> forall a. Maybe a
Nothing
  [ValidValue]
args -> forall a. a -> Maybe a
Just (SelectionContent VALID -> TypeName -> [ValidValue] -> BatchEntry
BatchEntry SelectionContent VALID
tSel TypeName
tName [ValidValue]
args)
    where

  where
    gerArgs :: [(a, NamedResolverRef)] -> [ValidValue]
gerArgs = forall a. (Eq a, Hashable a) => [a] -> [a]
uniq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NamedResolverRef -> [ValidValue]
resolverArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
    areEq :: SelectionRef -> Bool
areEq (SelectionContent VALID
sel, NamedResolverRef
v) = SelectionContent VALID
sel forall a. Eq a => a -> a -> Bool
== SelectionContent VALID
tSel Bool -> Bool -> Bool
&& TypeName
tName forall a. Eq a => a -> a -> Bool
== NamedResolverRef -> TypeName
resolverTypeName NamedResolverRef
v

newtype ResolverMapT m a = ResolverMapT
  { forall (m :: * -> *) a.
ResolverMapT m a -> ReaderT (ResolverMap m) (CacheT m) a
_runResMapT :: ReaderT (ResolverMap m) (CacheT m) a
  }
  deriving
    ( forall a b. a -> ResolverMapT m b -> ResolverMapT m a
forall a b. (a -> b) -> ResolverMapT m a -> ResolverMapT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ResolverMapT m b -> ResolverMapT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResolverMapT m a -> ResolverMapT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ResolverMapT m b -> ResolverMapT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ResolverMapT m b -> ResolverMapT m a
fmap :: forall a b. (a -> b) -> ResolverMapT m a -> ResolverMapT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResolverMapT m a -> ResolverMapT m b
Functor,
      forall a. a -> ResolverMapT m a
forall a b.
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m a
forall a b.
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m b
forall a b.
ResolverMapT m (a -> b) -> ResolverMapT m a -> ResolverMapT m b
forall a b c.
(a -> b -> c)
-> ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m c
forall {m :: * -> *}. Monad m => Functor (ResolverMapT m)
forall (m :: * -> *) a. Monad m => a -> ResolverMapT m a
forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m a
forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m b
forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m (a -> b) -> ResolverMapT m a -> ResolverMapT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m a
*> :: forall a b.
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m c
<*> :: forall a b.
ResolverMapT m (a -> b) -> ResolverMapT m a -> ResolverMapT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m (a -> b) -> ResolverMapT m a -> ResolverMapT m b
pure :: forall a. a -> ResolverMapT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> ResolverMapT m a
Applicative,
      forall a. a -> ResolverMapT m a
forall a b.
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m b
forall a b.
ResolverMapT m a -> (a -> ResolverMapT m b) -> ResolverMapT m b
forall (m :: * -> *). Monad m => Applicative (ResolverMapT m)
forall (m :: * -> *) a. Monad m => a -> ResolverMapT m a
forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m b
forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m a -> (a -> ResolverMapT m b) -> ResolverMapT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ResolverMapT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> ResolverMapT m a
>> :: forall a b.
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m a -> ResolverMapT m b -> ResolverMapT m b
>>= :: forall a b.
ResolverMapT m a -> (a -> ResolverMapT m b) -> ResolverMapT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ResolverMapT m a -> (a -> ResolverMapT m b) -> ResolverMapT m b
Monad
    )

instance (MonadReader ResolverContext m) => MonadReader ResolverContext (ResolverMapT m) where
  ask :: ResolverMapT m ResolverContext
ask = forall (m :: * -> *) a.
ReaderT (ResolverMap m) (CacheT m) a -> ResolverMapT m a
ResolverMapT (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask)
  local :: forall a.
(ResolverContext -> ResolverContext)
-> ResolverMapT m a -> ResolverMapT m a
local ResolverContext -> ResolverContext
f (ResolverMapT ReaderT (ResolverMap m) (CacheT m) a
m) = forall (m :: * -> *) a.
ReaderT (ResolverMap m) (CacheT m) a -> ResolverMapT m a
ResolverMapT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ResolverContext -> ResolverContext
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (ResolverMap m) (CacheT m) a
m))

instance MonadTrans ResolverMapT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ResolverMapT m a
lift = forall (m :: * -> *) a.
ReaderT (ResolverMap m) (CacheT m) a -> ResolverMapT m a
ResolverMapT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

deriving instance MonadError GQLError m => MonadError GQLError (ResolverMapT m)

runBatchedT :: Monad m => ResolverMapT m a -> ResolverMap m -> m a
runBatchedT :: forall (m :: * -> *) a.
Monad m =>
ResolverMapT m a -> ResolverMap m -> m a
runBatchedT (ResolverMapT ReaderT (ResolverMap m) (CacheT m) a
m) ResolverMap m
rmap = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (ResolverMap m) (CacheT m) a
m ResolverMap m
rmap) forall coll. Empty coll => coll
empty

toKeys :: BatchEntry -> [CacheKey]
toKeys :: BatchEntry -> [CacheKey]
toKeys (BatchEntry SelectionContent VALID
sel TypeName
name [ValidValue]
deps) = forall a b. (a -> b) -> [a] -> [b]
map (SelectionContent VALID -> TypeName -> ValidValue -> CacheKey
CacheKey SelectionContent VALID
sel TypeName
name) [ValidValue]
deps

inCache :: Monad m => CacheT m a -> ResolverMapT m a
inCache :: forall (m :: * -> *) a. Monad m => CacheT m a -> ResolverMapT m a
inCache = forall (m :: * -> *) a.
ReaderT (ResolverMap m) (CacheT m) a -> ResolverMapT m a
ResolverMapT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

class MonadTrans t => MonadBatching t where
  resolveRef :: ResolverMonad m => SelectionContent VALID -> NamedResolverRef -> t m (CacheKey, CacheValue m)
  storeValue :: ResolverMonad m => CacheKey -> ValidValue -> t m ValidValue

instance MonadBatching IdentityT where
  resolveRef :: forall (m :: * -> *).
ResolverMonad m =>
SelectionContent VALID
-> NamedResolverRef -> IdentityT m (CacheKey, CacheValue m)
resolveRef SelectionContent VALID
_ NamedResolverRef
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ GQLError -> GQLError
internal GQLError
"batching is only allowed with named resolvers"
  storeValue :: forall (m :: * -> *).
ResolverMonad m =>
CacheKey -> ValidValue -> IdentityT m ValidValue
storeValue CacheKey
_ ValidValue
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ GQLError -> GQLError
internal GQLError
"batching is only allowed with named resolvers"

instance MonadBatching ResolverMapT where
  resolveRef :: forall (m :: * -> *).
ResolverMonad m =>
SelectionContent VALID
-> NamedResolverRef -> ResolverMapT m (CacheKey, CacheValue m)
resolveRef SelectionContent VALID
sel (NamedResolverRef TypeName
typename [ValidValue
arg]) = do
    let key :: CacheKey
key = SelectionContent VALID -> TypeName -> ValidValue -> CacheKey
CacheKey SelectionContent VALID
sel TypeName
typename ValidValue
arg
    Bool
alreadyCached <- forall (m :: * -> *) a. Monad m => CacheT m a -> ResolverMapT m a
inCache (forall (m :: * -> *). Monad m => CacheKey -> CacheT m Bool
isCached CacheKey
key)
    if Bool
alreadyCached
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      else forall (m :: * -> *).
ResolverMonad m =>
BatchEntry -> ResolverMapT m ()
prefetch (SelectionContent VALID -> TypeName -> [ValidValue] -> BatchEntry
BatchEntry SelectionContent VALID
sel TypeName
typename [ValidValue
arg])
    forall (m :: * -> *) a. Monad m => CacheT m a -> ResolverMapT m a
inCache forall a b. (a -> b) -> a -> b
$ do
      CacheValue m
value <- forall (m :: * -> *).
ResolverMonad m =>
CacheKey -> CacheT m (CacheValue m)
useCached CacheKey
key
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (CacheKey
key, CacheValue m
value)
  resolveRef SelectionContent VALID
_ NamedResolverRef
ref = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal (GQLError
"expected only one resolved value for " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (forall a. Show a => a -> String
show NamedResolverRef
ref :: String)))
  storeValue :: forall (m :: * -> *).
ResolverMonad m =>
CacheKey -> ValidValue -> ResolverMapT m ValidValue
storeValue CacheKey
key = forall (m :: * -> *) a. Monad m => CacheT m a -> ResolverMapT m a
inCache forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Monad m =>
CacheKey -> ValidValue -> CacheT m ValidValue
cacheValue CacheKey
key

prefetch :: ResolverMonad m => BatchEntry -> ResolverMapT m ()
prefetch :: forall (m :: * -> *).
ResolverMonad m =>
BatchEntry -> ResolverMapT m ()
prefetch BatchEntry
batch = do
  [ResolverValue m]
value <- BatchEntry -> ResolverMapT m [ResolverValue m]
run BatchEntry
batch
  [BatchEntry]
batches <- [SelectionRef] -> [BatchEntry]
buildBatches forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
ResolverMonad m =>
SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
scanRefs (BatchEntry -> SelectionContent VALID
batchedSelection BatchEntry
batch)) [ResolverValue m]
value
  [(BatchEntry, [ResolverValue m])]
resolvedEntries <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\BatchEntry
b -> (BatchEntry
b,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BatchEntry -> ResolverMapT m [ResolverValue m]
run BatchEntry
b) [BatchEntry]
batches
  let caches :: [(CacheKey, ResolverValue m)]
caches = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. (BatchEntry, [b]) -> [(CacheKey, b)]
zipCaches forall a b. (a -> b) -> a -> b
$ (BatchEntry
batch, [ResolverValue m]
value) forall a. a -> [a] -> [a]
: [(BatchEntry, [ResolverValue m])]
resolvedEntries
  forall (m :: * -> *) a. Monad m => CacheT m a -> ResolverMapT m a
inCache forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
ResolverMonad m =>
[(CacheKey, ResolverValue m)] -> CacheT m ()
cacheResolverValues [(CacheKey, ResolverValue m)]
caches
  where
    zipCaches :: (BatchEntry, [b]) -> [(CacheKey, b)]
zipCaches (BatchEntry
b, [b]
res) = forall a b. [a] -> [b] -> [(a, b)]
zip (BatchEntry -> [CacheKey]
toKeys BatchEntry
b) [b]
res
    run :: BatchEntry -> ResolverMapT m [ResolverValue m]
run = forall a (m :: * -> *).
(Show a, MonadReader ResolverContext m) =>
a -> m a
withDebug forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
BatchEntry -> ResolverMapT m [ResolverValue m]
runBatch

runBatch :: (MonadError GQLError m, MonadReader ResolverContext m) => BatchEntry -> ResolverMapT m [ResolverValue m]
runBatch :: forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
BatchEntry -> ResolverMapT m [ResolverValue m]
runBatch (BatchEntry SelectionContent VALID
_ TypeName
name [ValidValue]
deps)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ValidValue]
deps = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | Bool
otherwise = do
      HashMap TypeName (NamedResolver m)
resolvers <- forall (m :: * -> *) a.
ReaderT (ResolverMap m) (CacheT m) a -> ResolverMapT m a
ResolverMapT forall r (m :: * -> *). MonadReader r m => m r
ask
      NamedResolver {NamedResolverFun m
resolverFun :: forall (m :: * -> *). NamedResolver m -> NamedResolverFun m
resolverFun :: NamedResolverFun m
resolverFun} <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr m (NamedResolver m)
notFound forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeName
name HashMap TypeName (NamedResolver m)
resolvers)
      forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *).
Monad m =>
TypeName -> NamedResolverResult m -> ResolverValue m
toResolverValue TypeName
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NamedResolverFun m
resolverFun [ValidValue]
deps)
  where
    notFound :: m (NamedResolver m)
notFound = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError
"resolver type " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
name forall a. Semigroup a => a -> a -> a
<> GQLError
"can't found")

toResolverValue :: (Monad m) => TypeName -> NamedResolverResult m -> ResolverValue m
toResolverValue :: forall (m :: * -> *).
Monad m =>
TypeName -> NamedResolverResult m -> ResolverValue m
toResolverValue TypeName
typeName (NamedObjectResolver ObjectTypeResolver m
res) = forall (m :: * -> *).
Maybe TypeName -> ObjectTypeResolver m -> ResolverValue m
ResObject (forall a. a -> Maybe a
Just TypeName
typeName) ObjectTypeResolver m
res
toResolverValue TypeName
_ (NamedUnionResolver NamedResolverRef
unionRef) = forall (m :: * -> *). m NamedResolverRef -> ResolverValue m
ResRef forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure NamedResolverRef
unionRef
toResolverValue TypeName
_ (NamedEnumResolver TypeName
value) = forall (m :: * -> *). TypeName -> ResolverValue m
ResEnum TypeName
value
toResolverValue TypeName
_ NamedResolverResult m
NamedNullResolver = forall (m :: * -> *). ResolverValue m
ResNull
toResolverValue TypeName
_ (NamedScalarResolver ScalarValue
v) = forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar ScalarValue
v