{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.App.Internal.Resolving.ResolveValue
  ( resolveRef,
    resolveObject,
    ResolverMapContext (..),
  )
where

import Control.Monad.Except (MonadError (throwError))
import qualified Data.HashMap.Lazy as HM
import Data.Morpheus.App.Internal.Resolving.Batching
  ( CacheKey (..),
    ResolverMapContext (..),
    ResolverMapT,
    buildCacheWith,
    runResMapT,
    useCached,
  )
import Data.Morpheus.App.Internal.Resolving.ResolverState
  ( ResolverContext (..),
    askFieldTypeName,
    updateCurrentType,
  )
import Data.Morpheus.App.Internal.Resolving.Types
  ( NamedResolver (..),
    NamedResolverRef (..),
    NamedResolverResult (..),
    ObjectTypeResolver (..),
    ResolverMap,
    ResolverValue (..),
    mkEnum,
    mkUnion,
  )
import Data.Morpheus.Error (subfieldsNotSelected)
import Data.Morpheus.Internal.Utils
  ( KeyOf (keyOf),
    empty,
    selectOr,
    traverseCollection,
    (<:>),
  )
import Data.Morpheus.Types.Internal.AST
  ( GQLError,
    Msg (msg),
    ObjectEntry (ObjectEntry),
    ScalarValue (..),
    Selection (..),
    SelectionContent (..),
    SelectionSet,
    TypeDefinition (..),
    TypeName,
    UnionTag (unionTagSelection),
    VALID,
    ValidValue,
    Value (..),
    internal,
    unitFieldName,
    unitTypeName,
    unpackName,
  )
import Relude hiding (empty)

scanRefs :: (MonadError GQLError m, MonadReader ResolverContext m) => SelectionContent VALID -> ResolverValue m -> m [(SelectionContent VALID, NamedResolverRef)]
scanRefs :: forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
SelectionContent VALID
-> ResolverValue m
-> m [(SelectionContent VALID, NamedResolverRef)]
scanRefs SelectionContent VALID
sel (ResList [ResolverValue m]
xs) = 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 (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
SelectionContent VALID
-> ResolverValue m
-> m [(SelectionContent VALID, NamedResolverRef)]
scanRefs SelectionContent VALID
sel) [ResolverValue m]
xs
scanRefs SelectionContent VALID
sel (ResLazy m (ResolverValue m)
x) = m (ResolverValue m)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
SelectionContent VALID
-> ResolverValue m
-> m [(SelectionContent VALID, NamedResolverRef)]
scanRefs SelectionContent VALID
sel
scanRefs SelectionContent VALID
sel (ResObject Maybe TypeName
tyName ObjectTypeResolver m
obj) = forall (m :: * -> *) value.
(MonadError GQLError m, MonadReader ResolverContext m) =>
Maybe TypeName
-> (Maybe (SelectionSet VALID) -> m value)
-> SelectionContent VALID
-> m value
withObject Maybe TypeName
tyName (forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ObjectTypeResolver m
-> Maybe (SelectionSet VALID)
-> m [(SelectionContent VALID, NamedResolverRef)]
objectRefs ObjectTypeResolver m
obj) SelectionContent VALID
sel
scanRefs SelectionContent VALID
sel (ResRef m NamedResolverRef
ref) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SelectionContent VALID
sel,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m NamedResolverRef
ref
scanRefs SelectionContent VALID
_ ResEnum {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
scanRefs SelectionContent VALID
_ ResolverValue m
ResNull = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
scanRefs SelectionContent VALID
_ ResScalar {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

objectRefs ::
  ( MonadError GQLError m,
    MonadReader ResolverContext m
  ) =>
  ObjectTypeResolver m ->
  Maybe (SelectionSet VALID) ->
  m [(SelectionContent VALID, NamedResolverRef)]
objectRefs :: forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ObjectTypeResolver m
-> Maybe (SelectionSet VALID)
-> m [(SelectionContent VALID, NamedResolverRef)]
objectRefs ObjectTypeResolver m
_ Maybe (SelectionSet VALID)
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
objectRefs ObjectTypeResolver m
dr (Just SelectionSet VALID
sel) = 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 (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ObjectTypeResolver m
-> Selection VALID
-> m [(SelectionContent VALID, NamedResolverRef)]
fieldRefs ObjectTypeResolver m
dr) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet VALID
sel)

fieldRefs ::
  (MonadError GQLError m, MonadReader ResolverContext m) =>
  ObjectTypeResolver m ->
  Selection VALID ->
  m [(SelectionContent VALID, NamedResolverRef)]
fieldRefs :: forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ObjectTypeResolver m
-> Selection VALID
-> m [(SelectionContent VALID, NamedResolverRef)]
fieldRefs ObjectTypeResolver {HashMap FieldName (m (ResolverValue m))
objectFields :: forall (m :: * -> *).
ObjectTypeResolver m -> HashMap FieldName (m (ResolverValue m))
objectFields :: HashMap FieldName (m (ResolverValue m))
..} currentSelection :: Selection VALID
currentSelection@Selection {Maybe FragmentName
Maybe FieldName
SelectionContent VALID
FieldName
Position
Arguments VALID
Directives VALID
selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionAlias :: forall (s :: Stage). Selection s -> Maybe FieldName
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionArguments :: forall (s :: Stage). Selection s -> Arguments s
selectionDirectives :: forall (s :: Stage). Selection s -> Directives s
selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionOrigin :: forall (s :: Stage). Selection s -> Maybe FragmentName
selectionOrigin :: Maybe FragmentName
selectionContent :: SelectionContent VALID
selectionDirectives :: Directives VALID
selectionArguments :: Arguments VALID
selectionName :: FieldName
selectionAlias :: Maybe FieldName
selectionPosition :: Position
..}
  | FieldName
selectionName forall a. Eq a => a -> a -> Bool
== FieldName
"__typename" = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | Bool
otherwise = do
      Maybe TypeName
t <- forall (m :: * -> *).
MonadReader ResolverContext m =>
FieldName -> m (Maybe TypeName)
askFieldTypeName FieldName
selectionName
      forall (m :: * -> *) a.
(MonadReader ResolverContext m, MonadError GQLError m) =>
Maybe TypeName -> m a -> m a
updateCurrentType Maybe TypeName
t forall a b. (a -> b) -> a -> b
$
        forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ResolverContext
ctx -> ResolverContext
ctx {Selection VALID
currentSelection :: Selection VALID
currentSelection :: Selection VALID
currentSelection}) forall a b. (a -> b) -> a -> b
$ do
          [ResolverValue m]
x <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure) (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup FieldName
selectionName HashMap FieldName (m (ResolverValue m))
objectFields)
          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 (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
SelectionContent VALID
-> ResolverValue m
-> m [(SelectionContent VALID, NamedResolverRef)]
scanRefs SelectionContent VALID
selectionContent) [ResolverValue m]
x

resolveSelection ::
  ( Monad m,
    MonadReader ResolverContext m,
    MonadError GQLError m
  ) =>
  ResolverValue m ->
  SelectionContent VALID ->
  ResolverMapT m ValidValue
resolveSelection :: forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
resolveSelection ResolverValue m
res SelectionContent VALID
selection = do
  ResolverMapContext m
ctx <- forall r (m :: * -> *). MonadReader r m => m r
ask
  ResolverMapContext m
newRmap <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
SelectionContent VALID
-> ResolverValue m
-> m [(SelectionContent VALID, NamedResolverRef)]
scanRefs SelectionContent VALID
selection ResolverValue m
res forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ResolverMapContext m
-> [(SelectionContent VALID, NamedResolverRef)]
-> m (ResolverMapContext m)
buildCache ResolverMapContext m
ctx)
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall a b. a -> b -> a
const ResolverMapContext m
newRmap) (forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
__resolveSelection ResolverValue m
res SelectionContent VALID
selection)

buildCache :: (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> [(SelectionContent VALID, NamedResolverRef)] -> m (ResolverMapContext m)
buildCache :: forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ResolverMapContext m
-> [(SelectionContent VALID, NamedResolverRef)]
-> m (ResolverMapContext m)
buildCache ctx :: ResolverMapContext m
ctx@(ResolverMapContext LocalCache
cache ResolverMap m
rmap) [(SelectionContent VALID, NamedResolverRef)]
entries = (forall (m :: * -> *).
LocalCache -> ResolverMap m -> ResolverMapContext m
`ResolverMapContext` ResolverMap m
rmap) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
ResolverFun m
-> LocalCache
-> [(SelectionContent VALID, NamedResolverRef)]
-> m LocalCache
buildCacheWith (forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ResolverMapContext m
-> NamedResolverRef -> SelectionContent VALID -> m [ValidValue]
resolveRefsCached ResolverMapContext m
ctx) LocalCache
cache [(SelectionContent VALID, NamedResolverRef)]
entries

__resolveSelection ::
  ( Monad m,
    MonadReader ResolverContext m,
    MonadError GQLError m
  ) =>
  ResolverValue m ->
  SelectionContent VALID ->
  ResolverMapT m ValidValue
__resolveSelection :: forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
__resolveSelection (ResLazy m (ResolverValue m)
x) SelectionContent VALID
selection = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (ResolverValue m)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
`resolveSelection` SelectionContent VALID
selection)
__resolveSelection (ResList [ResolverValue m]
xs) SelectionContent VALID
selection = forall (stage :: Stage). [Value stage] -> Value stage
List 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 (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
`resolveSelection` SelectionContent VALID
selection) [ResolverValue m]
xs
__resolveSelection (ResObject Maybe TypeName
tyName ObjectTypeResolver m
obj) SelectionContent VALID
sel = do
  ResolverMapContext m
ctx <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) value.
(MonadError GQLError m, MonadReader ResolverContext m) =>
Maybe TypeName
-> (Maybe (SelectionSet VALID) -> m value)
-> SelectionContent VALID
-> m value
withObject Maybe TypeName
tyName (forall (m :: * -> *).
(MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverMapContext m
-> ObjectTypeResolver m
-> Maybe (SelectionSet VALID)
-> m ValidValue
resolveObject ResolverMapContext m
ctx ObjectTypeResolver m
obj) SelectionContent VALID
sel
__resolveSelection (ResEnum TypeName
name) SelectionContent VALID
SelectionField = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (stage :: Stage). ScalarValue -> Value stage
Scalar forall a b. (a -> b) -> a -> b
$ Text -> ScalarValue
String forall a b. (a -> b) -> a -> b
$ forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name
__resolveSelection (ResEnum TypeName
name) unionSel :: SelectionContent VALID
unionSel@UnionSelection {} = forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
resolveSelection (forall (m :: * -> *).
Monad m =>
TypeName -> [ResolverEntry m] -> ResolverValue m
mkUnion TypeName
name [(FieldName
unitFieldName, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). TypeName -> ResolverValue m
mkEnum TypeName
unitTypeName)]) SelectionContent VALID
unionSel
__resolveSelection ResEnum {} SelectionContent VALID
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"wrong selection on enum value")
__resolveSelection ResolverValue m
ResNull SelectionContent VALID
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (stage :: Stage). Value stage
Null
__resolveSelection (ResScalar ScalarValue
x) SelectionContent VALID
SelectionField = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (stage :: Stage). ScalarValue -> Value stage
Scalar ScalarValue
x
__resolveSelection ResScalar {} SelectionContent VALID
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"scalar Resolver should only receive SelectionField")
__resolveSelection (ResRef m NamedResolverRef
ref) SelectionContent VALID
sel = do
  ResolverMapContext m
ctx <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m NamedResolverRef
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ResolverMapContext m
-> NamedResolverRef -> SelectionContent VALID -> m ValidValue
resolveRef ResolverMapContext m
ctx) SelectionContent VALID
sel)

withObject ::
  ( MonadError GQLError m,
    MonadReader ResolverContext m
  ) =>
  Maybe TypeName ->
  (Maybe (SelectionSet VALID) -> m value) ->
  SelectionContent VALID ->
  m value
withObject :: forall (m :: * -> *) value.
(MonadError GQLError m, MonadReader ResolverContext m) =>
Maybe TypeName
-> (Maybe (SelectionSet VALID) -> m value)
-> SelectionContent VALID
-> m value
withObject Maybe TypeName
__typename Maybe (SelectionSet VALID) -> m value
f = forall (m :: * -> *) a.
(MonadReader ResolverContext m, MonadError GQLError m) =>
Maybe TypeName -> m a -> m a
updateCurrentType Maybe TypeName
__typename forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionContent VALID -> m value
checkContent
  where
    checkContent :: SelectionContent VALID -> m value
checkContent (SelectionSet SelectionSet VALID
selection) = Maybe (SelectionSet VALID) -> m value
f (forall a. a -> Maybe a
Just SelectionSet VALID
selection)
    checkContent (UnionSelection Maybe (SelectionSet VALID)
interface UnionSelection VALID
unionSel) = do
      TypeName
typename <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext -> TypeDefinition ANY VALID
currentType)
      Maybe (MergeMap 'False FieldName (Selection VALID))
selection <- forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr (forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SelectionSet VALID)
interface) (forall {f :: * -> *}.
MonadError GQLError f =>
Maybe (MergeMap 'False FieldName (Selection VALID))
-> UnionTag
-> f (Maybe (MergeMap 'False FieldName (Selection VALID)))
fx Maybe (SelectionSet VALID)
interface) TypeName
typename UnionSelection VALID
unionSel
      Maybe (SelectionSet VALID) -> m value
f Maybe (MergeMap 'False FieldName (Selection VALID))
selection
      where
        fx :: Maybe (MergeMap 'False FieldName (Selection VALID))
-> UnionTag
-> f (Maybe (MergeMap 'False FieldName (Selection VALID)))
fx (Just MergeMap 'False FieldName (Selection VALID)
x) UnionTag
y = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MergeMap 'False FieldName (Selection VALID)
x forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> UnionTag -> SelectionSet VALID
unionTagSelection UnionTag
y)
        fx Maybe (MergeMap 'False FieldName (Selection VALID))
Nothing UnionTag
y = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ UnionTag -> SelectionSet VALID
unionTagSelection UnionTag
y
    checkContent SelectionContent VALID
SelectionField = forall (m :: * -> *) value.
(MonadError GQLError m, MonadReader ResolverContext m) =>
m value
noEmptySelection

noEmptySelection :: (MonadError GQLError m, MonadReader ResolverContext m) => m value
noEmptySelection :: forall (m :: * -> *) value.
(MonadError GQLError m, MonadReader ResolverContext m) =>
m value
noEmptySelection = do
  Selection VALID
sel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ResolverContext -> Selection VALID
currentSelection
  forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ FieldName -> TypeName -> Position -> GQLError
subfieldsNotSelected (forall (s :: Stage). Selection s -> FieldName
selectionName Selection VALID
sel) TypeName
"" (forall (s :: Stage). Selection s -> Position
selectionPosition Selection VALID
sel)

resolveRef ::
  ( MonadError GQLError m,
    MonadReader ResolverContext m
  ) =>
  ResolverMapContext m ->
  NamedResolverRef ->
  SelectionContent VALID ->
  m ValidValue
resolveRef :: forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ResolverMapContext m
-> NamedResolverRef -> SelectionContent VALID -> m ValidValue
resolveRef ResolverMapContext m
rmap NamedResolverRef
ref SelectionContent VALID
selection = forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ResolverMapContext m
-> NamedResolverRef -> SelectionContent VALID -> m [ValidValue]
resolveRefsCached ResolverMapContext m
rmap NamedResolverRef
ref SelectionContent VALID
selection forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a.
(MonadError GQLError f, Show a) =>
[a] -> f a
toOne

toOne :: (MonadError GQLError f, Show a) => [a] -> f a
toOne :: forall (f :: * -> *) a.
(MonadError GQLError f, Show a) =>
[a] -> f a
toOne [a
x] = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
toOne [a]
x = 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 b a. (Show a, IsString b) => a -> b
show [a]
x :: String)))

resolveRefsCached ::
  ( MonadError GQLError m,
    MonadReader ResolverContext m
  ) =>
  ResolverMapContext m ->
  NamedResolverRef ->
  SelectionContent VALID ->
  m [ValidValue]
resolveRefsCached :: forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ResolverMapContext m
-> NamedResolverRef -> SelectionContent VALID -> m [ValidValue]
resolveRefsCached ResolverMapContext m
ctx (NamedResolverRef TypeName
name [ValidValue]
args) SelectionContent VALID
selection = do
  let keys :: [CacheKey]
keys = forall a b. (a -> b) -> [a] -> [b]
map (SelectionContent VALID -> TypeName -> ValidValue -> CacheKey
CacheKey SelectionContent VALID
selection TypeName
name) [ValidValue]
args
  let cached :: [(ValidValue, Maybe ValidValue)]
cached = forall a b. (a -> b) -> [a] -> [b]
map CacheKey -> (ValidValue, Maybe ValidValue)
resolveCached [CacheKey]
keys
  let cachedMap :: HashMap ValidValue ValidValue
cachedMap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {b}. (a, Maybe b) -> Maybe (a, b)
unp [(ValidValue, Maybe ValidValue)]
cached)
  HashMap ValidValue ValidValue
notCachedMap <- forall (m :: * -> *) a.
ResolverMapT m a -> ResolverMapContext m -> m a
runResMapT (forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
TypeName
-> SelectionContent VALID
-> [ValidValue]
-> ResolverMapT m (HashMap ValidValue ValidValue)
resolveUncached TypeName
name SelectionContent VALID
selection forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(ValidValue, Maybe ValidValue)]
cached) ResolverMapContext m
ctx
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall k (f :: * -> *) a.
(Eq k, Show k, Hashable k, MonadError GQLError f) =>
HashMap k a -> k -> f a
useCached (HashMap ValidValue ValidValue
cachedMap forall a. Semigroup a => a -> a -> a
<> HashMap ValidValue ValidValue
notCachedMap)) [ValidValue]
args
  where
    unp :: (a, Maybe b) -> Maybe (a, b)
unp (a
_, Maybe b
Nothing) = forall a. Maybe a
Nothing
    unp (a
x, Just b
y) = forall a. a -> Maybe a
Just (a
x, b
y)
    resolveCached :: CacheKey -> (ValidValue, Maybe ValidValue)
resolveCached CacheKey
key = (CacheKey -> ValidValue
cachedArg CacheKey
key, forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup CacheKey
key forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ResolverMapContext m -> LocalCache
localCache ResolverMapContext m
ctx)

processResult ::
  (MonadError GQLError m, MonadReader ResolverContext m) =>
  TypeName ->
  SelectionContent VALID ->
  NamedResolverResult m ->
  ResolverMapT m ValidValue
processResult :: forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
TypeName
-> SelectionContent VALID
-> NamedResolverResult m
-> ResolverMapT m ValidValue
processResult TypeName
typename SelectionContent VALID
selection (NamedObjectResolver ObjectTypeResolver m
res) = do
  ResolverMapContext m
ctx <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) value.
(MonadError GQLError m, MonadReader ResolverContext m) =>
Maybe TypeName
-> (Maybe (SelectionSet VALID) -> m value)
-> SelectionContent VALID
-> m value
withObject (forall a. a -> Maybe a
Just TypeName
typename) (forall (m :: * -> *).
(MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverMapContext m
-> ObjectTypeResolver m
-> Maybe (SelectionSet VALID)
-> m ValidValue
resolveObject ResolverMapContext m
ctx ObjectTypeResolver m
res) SelectionContent VALID
selection
processResult TypeName
_ SelectionContent VALID
selection (NamedUnionResolver NamedResolverRef
unionRef) = forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
resolveSelection (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) SelectionContent VALID
selection
processResult TypeName
_ SelectionContent VALID
selection (NamedEnumResolver TypeName
value) = forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
resolveSelection (forall (m :: * -> *). TypeName -> ResolverValue m
ResEnum TypeName
value) SelectionContent VALID
selection
processResult TypeName
_ SelectionContent VALID
selection NamedResolverResult m
NamedNullResolver = forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
resolveSelection forall (m :: * -> *). ResolverValue m
ResNull SelectionContent VALID
selection

resolveUncached ::
  ( MonadError GQLError m,
    MonadReader ResolverContext m
  ) =>
  TypeName ->
  SelectionContent VALID ->
  [ValidValue] ->
  ResolverMapT m (HashMap ValidValue ValidValue)
resolveUncached :: forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
TypeName
-> SelectionContent VALID
-> [ValidValue]
-> ResolverMapT m (HashMap ValidValue ValidValue)
resolveUncached TypeName
_ SelectionContent VALID
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall coll. Empty coll => coll
empty
resolveUncached TypeName
typename SelectionContent VALID
selection [ValidValue]
xs = do
  ResolverMap m
rmap <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *). ResolverMapContext m -> ResolverMap m
resolverMap
  [ValidValue]
vs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
MonadError GQLError m =>
NamedResolverRef -> ResolverMap m -> m [NamedResolverResult m]
getNamedResolverBy (TypeName -> [ValidValue] -> NamedResolverRef
NamedResolverRef TypeName
typename [ValidValue]
xs) ResolverMap m
rmap) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
TypeName
-> SelectionContent VALID
-> NamedResolverResult m
-> ResolverMapT m ValidValue
processResult TypeName
typename SelectionContent VALID
selection)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [ValidValue]
xs [ValidValue]
vs)

getNamedResolverBy ::
  (MonadError GQLError m) =>
  NamedResolverRef ->
  ResolverMap m ->
  m [NamedResolverResult m]
getNamedResolverBy :: forall (m :: * -> *).
MonadError GQLError m =>
NamedResolverRef -> ResolverMap m -> m [NamedResolverResult m]
getNamedResolverBy NamedResolverRef {[ValidValue]
TypeName
resolverArgument :: NamedResolverRef -> [ValidValue]
resolverTypeName :: NamedResolverRef -> TypeName
resolverArgument :: [ValidValue]
resolverTypeName :: TypeName
..} = forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr m [NamedResolverResult m]
cantFoundError (([ValidValue]
resolverArgument forall a b. a -> (a -> b) -> b
&) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). NamedResolver m -> NamedResolverFun m
resolverFun) TypeName
resolverTypeName
  where
    cantFoundError :: m [NamedResolverResult m]
cantFoundError = 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
resolverTypeName forall a. Semigroup a => a -> a -> a
<> GQLError
"can't found")

resolveObject ::
  ( MonadReader ResolverContext m,
    MonadError GQLError m
  ) =>
  ResolverMapContext m ->
  ObjectTypeResolver m ->
  Maybe (SelectionSet VALID) ->
  m ValidValue
resolveObject :: forall (m :: * -> *).
(MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverMapContext m
-> ObjectTypeResolver m
-> Maybe (SelectionSet VALID)
-> m ValidValue
resolveObject ResolverMapContext m
rmap ObjectTypeResolver m
drv Maybe (SelectionSet VALID)
sel = do
  ResolverMapContext m
newCache <- forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ObjectTypeResolver m
-> Maybe (SelectionSet VALID)
-> m [(SelectionContent VALID, NamedResolverRef)]
objectRefs ObjectTypeResolver m
drv Maybe (SelectionSet VALID)
sel forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadError GQLError m, MonadReader ResolverContext m) =>
ResolverMapContext m
-> [(SelectionContent VALID, NamedResolverRef)]
-> m (ResolverMapContext m)
buildCache ResolverMapContext m
rmap
  forall (stage :: Stage). Object stage -> Value stage
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall coll. Empty coll => coll
empty) (forall (m :: * -> *) k b (map :: * -> * -> *) (t :: * -> *) a.
(Monad m, MonadError GQLError m, KeyOf k b, FromList m map k b,
 Foldable t) =>
(a -> m b) -> t a -> m (map k b)
traverseCollection (ResolverMapContext m -> Selection VALID -> m (ObjectEntry VALID)
resolver ResolverMapContext m
newCache)) Maybe (SelectionSet VALID)
sel
  where
    resolver :: ResolverMapContext m -> Selection VALID -> m (ObjectEntry VALID)
resolver ResolverMapContext m
cacheCTX Selection VALID
currentSelection = do
      Maybe TypeName
t <- forall (m :: * -> *).
MonadReader ResolverContext m =>
FieldName -> m (Maybe TypeName)
askFieldTypeName (forall (s :: Stage). Selection s -> FieldName
selectionName Selection VALID
currentSelection)
      forall (m :: * -> *) a.
(MonadReader ResolverContext m, MonadError GQLError m) =>
Maybe TypeName -> m a -> m a
updateCurrentType Maybe TypeName
t forall a b. (a -> b) -> a -> b
$
        forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ResolverContext
ctx -> ResolverContext
ctx {Selection VALID
currentSelection :: Selection VALID
currentSelection :: Selection VALID
currentSelection}) forall a b. (a -> b) -> a -> b
$
          forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry (forall k a. KeyOf k a => a -> k
keyOf Selection VALID
currentSelection)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
ResolverMapT m a -> ResolverMapContext m -> m a
runResMapT (forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
Selection VALID
-> ObjectTypeResolver m -> ResolverMapT m ValidValue
runFieldResolver Selection VALID
currentSelection ObjectTypeResolver m
drv) ResolverMapContext m
cacheCTX

runFieldResolver ::
  ( Monad m,
    MonadReader ResolverContext m,
    MonadError GQLError m
  ) =>
  Selection VALID ->
  ObjectTypeResolver m ->
  ResolverMapT m ValidValue
runFieldResolver :: forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
Selection VALID
-> ObjectTypeResolver m -> ResolverMapT m ValidValue
runFieldResolver Selection {FieldName
selectionName :: FieldName
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionName, SelectionContent VALID
selectionContent :: SelectionContent VALID
selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent}
  | FieldName
selectionName forall a. Eq a => a -> a -> Bool
== FieldName
"__typename" =
      forall a b. a -> b -> a
const (forall (stage :: Stage). ScalarValue -> Value stage
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ScalarValue
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName 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 (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext -> TypeDefinition ANY VALID
currentType)))
  | Bool
otherwise =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (stage :: Stage). Value stage
Null) (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (forall (m :: * -> *).
(Monad m, MonadReader ResolverContext m, MonadError GQLError m) =>
ResolverValue m
-> SelectionContent VALID -> ResolverMapT m ValidValue
`resolveSelection` SelectionContent VALID
selectionContent))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup FieldName
selectionName
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
ObjectTypeResolver m -> HashMap FieldName (m (ResolverValue m))
objectFields