{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.App.Internal.Resolving.Refs
  ( scanRefs,
  )
where

import Data.Morpheus.App.Internal.Resolving.ResolverState
  ( inSelectionField,
  )
import Data.Morpheus.App.Internal.Resolving.Types (NamedResolverRef, ObjectTypeResolver (..), ResolverValue (..))
import Data.Morpheus.App.Internal.Resolving.Utils (ResolverMonad, withField, withObject)
import Data.Morpheus.Types.Internal.AST
  ( Selection (..),
    SelectionContent (..),
    SelectionSet,
    VALID,
  )
import Relude hiding (empty)

type SelectionRef = (SelectionContent VALID, NamedResolverRef)

scanRefs :: (ResolverMonad m) => SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
scanRefs :: forall (m :: * -> *).
ResolverMonad m =>
SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
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 :: * -> *).
ResolverMonad m =>
SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
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 :: * -> *).
ResolverMonad m =>
SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
scanRefs SelectionContent VALID
sel
scanRefs SelectionContent VALID
sel (ResObject Maybe TypeName
tyName ObjectTypeResolver m
obj) = forall (m :: * -> *) value.
ResolverMonad m =>
Maybe TypeName
-> (Maybe (SelectionSet VALID) -> m value)
-> SelectionContent VALID
-> m value
withObject Maybe TypeName
tyName (forall (m :: * -> *).
ResolverMonad m =>
ObjectTypeResolver m
-> Maybe (SelectionSet VALID) -> m [SelectionRef]
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 :: (ResolverMonad m) => ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m [SelectionRef]
objectRefs :: forall (m :: * -> *).
ResolverMonad m =>
ObjectTypeResolver m
-> Maybe (SelectionSet VALID) -> m [SelectionRef]
objectRefs ObjectTypeResolver m
_ Maybe (SelectionSet VALID)
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
objectRefs ObjectTypeResolver m
obj (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 :: * -> *).
ResolverMonad m =>
ObjectTypeResolver m -> Selection VALID -> m [SelectionRef]
fieldRefs ObjectTypeResolver m
obj) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet VALID
sel)

fieldRefs :: (ResolverMonad m) => ObjectTypeResolver m -> Selection VALID -> m [SelectionRef]
fieldRefs :: forall (m :: * -> *).
ResolverMonad m =>
ObjectTypeResolver m -> Selection VALID -> m [SelectionRef]
fieldRefs ObjectTypeResolver m
obj selection :: Selection VALID
selection@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 = forall (m :: * -> *) b.
(MonadReader ResolverContext m, MonadError GQLError m) =>
Selection VALID -> m b -> m b
inSelectionField Selection VALID
selection forall a b. (a -> b) -> a -> b
$ do
      [ResolverValue m]
resValue <- forall (m' :: * -> *) a (m :: * -> *).
Monad m' =>
a
-> (m (ResolverValue m) -> m' a)
-> FieldName
-> ObjectTypeResolver m
-> m' a
withField [] (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure) FieldName
selectionName ObjectTypeResolver m
obj
      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 :: * -> *).
ResolverMonad m =>
SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
scanRefs SelectionContent VALID
selectionContent) [ResolverValue m]
resValue