{-# 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) = [[SelectionRef]] -> [SelectionRef]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SelectionRef]] -> [SelectionRef])
-> m [[SelectionRef]] -> m [SelectionRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ResolverValue m -> m [SelectionRef])
-> [ResolverValue m] -> m [[SelectionRef]]
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 (SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
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 m (ResolverValue m)
-> (ResolverValue m -> m [SelectionRef]) -> m [SelectionRef]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
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) = Maybe TypeName
-> (Maybe (SelectionSet VALID) -> m [SelectionRef])
-> SelectionContent VALID
-> m [SelectionRef]
forall (m :: * -> *) value.
ResolverMonad m =>
Maybe TypeName
-> (Maybe (SelectionSet VALID) -> m value)
-> SelectionContent VALID
-> m value
withObject Maybe TypeName
tyName (ObjectTypeResolver m
-> Maybe (SelectionSet VALID) -> m [SelectionRef]
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) = SelectionRef -> [SelectionRef]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelectionRef -> [SelectionRef])
-> (NamedResolverRef -> SelectionRef)
-> NamedResolverRef
-> [SelectionRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SelectionContent VALID
sel,) (NamedResolverRef -> [SelectionRef])
-> m NamedResolverRef -> m [SelectionRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m NamedResolverRef
ref
scanRefs SelectionContent VALID
_ ResEnum {} = [SelectionRef] -> m [SelectionRef]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
scanRefs SelectionContent VALID
_ ResolverValue m
ResNull = [SelectionRef] -> m [SelectionRef]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
scanRefs SelectionContent VALID
_ ResScalar {} = [SelectionRef] -> m [SelectionRef]
forall a. a -> m a
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 = [SelectionRef] -> m [SelectionRef]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
objectRefs ObjectTypeResolver m
obj (Just SelectionSet VALID
sel) = [[SelectionRef]] -> [SelectionRef]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SelectionRef]] -> [SelectionRef])
-> m [[SelectionRef]] -> m [SelectionRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection VALID -> m [SelectionRef])
-> [Selection VALID] -> m [[SelectionRef]]
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 (ObjectTypeResolver m -> Selection VALID -> m [SelectionRef]
forall (m :: * -> *).
ResolverMonad m =>
ObjectTypeResolver m -> Selection VALID -> m [SelectionRef]
fieldRefs ObjectTypeResolver m
obj) (MergeMap 'False FieldName (Selection VALID) -> [Selection VALID]
forall a. MergeMap 'False FieldName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MergeMap 'False FieldName (Selection VALID)
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 FieldName
Maybe FragmentName
Directives VALID
Arguments VALID
Position
FieldName
SelectionContent VALID
selectionPosition :: Position
selectionAlias :: Maybe FieldName
selectionName :: FieldName
selectionArguments :: Arguments VALID
selectionDirectives :: Directives VALID
selectionContent :: SelectionContent VALID
selectionOrigin :: Maybe FragmentName
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
..}
  | FieldName
selectionName FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== FieldName
"__typename" = [SelectionRef] -> m [SelectionRef]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | Bool
otherwise = Selection VALID -> m [SelectionRef] -> m [SelectionRef]
forall (m :: * -> *) b.
(MonadReader ResolverContext m, MonadError GQLError m) =>
Selection VALID -> m b -> m b
inSelectionField Selection VALID
selection (m [SelectionRef] -> m [SelectionRef])
-> m [SelectionRef] -> m [SelectionRef]
forall a b. (a -> b) -> a -> b
$ do
      [ResolverValue m]
resValue <- [ResolverValue m]
-> (m (ResolverValue m) -> m [ResolverValue m])
-> FieldName
-> ObjectTypeResolver m
-> m [ResolverValue m]
forall (m' :: * -> *) a (m :: * -> *).
Monad m' =>
a
-> (m (ResolverValue m) -> m' a)
-> FieldName
-> ObjectTypeResolver m
-> m' a
withField [] ((ResolverValue m -> [ResolverValue m])
-> m (ResolverValue m) -> m [ResolverValue m]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResolverValue m -> [ResolverValue m]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) FieldName
selectionName ObjectTypeResolver m
obj
      [[SelectionRef]] -> [SelectionRef]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SelectionRef]] -> [SelectionRef])
-> m [[SelectionRef]] -> m [SelectionRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ResolverValue m -> m [SelectionRef])
-> [ResolverValue m] -> m [[SelectionRef]]
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 (SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
forall (m :: * -> *).
ResolverMonad m =>
SelectionContent VALID -> ResolverValue m -> m [SelectionRef]
scanRefs SelectionContent VALID
selectionContent) [ResolverValue m]
resValue