Use sequences of selections
This commit is contained in:
parent
5505739e21
commit
2dafb00a16
|
|
@ -34,11 +34,14 @@ import Data.Int (Int32)
|
|||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.Sequence (Seq, (><))
|
||||
import qualified Data.Sequence as Seq
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Language.GraphQL.Execute.Coerce as Coerce
|
||||
import Language.GraphQL.Execute.OrderedMap (OrderedMap)
|
||||
import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
import qualified Language.GraphQL.Type.Internal as Type.Internal
|
||||
|
|
@ -131,13 +134,13 @@ data Operation = Operation
|
|||
Type.Subs
|
||||
SelectionSet
|
||||
|
||||
type SelectionSet = [Selection]
|
||||
type SelectionSet = Seq Selection
|
||||
|
||||
data Selection
|
||||
= FieldSelection Field
|
||||
| FragmentSelection Fragment
|
||||
|
||||
data Argument = Argument Full.Name (Full.Node Value) Full.Location
|
||||
data Argument = Argument Full.Name (Full.Node Input) Full.Location
|
||||
|
||||
data Field = Field
|
||||
(Maybe Full.Name)
|
||||
|
|
@ -149,7 +152,7 @@ data Field = Field
|
|||
data Fragment = Fragment
|
||||
(Type.Internal.CompositeType IO) SelectionSet Full.Location
|
||||
|
||||
data Value
|
||||
data Input
|
||||
= Variable Full.Name
|
||||
| Int Int32
|
||||
| Float Double
|
||||
|
|
@ -157,12 +160,12 @@ data Value
|
|||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Full.Name
|
||||
| List [Full.Node Value]
|
||||
| List [Full.Node Input]
|
||||
| Object [ObjectField]
|
||||
|
||||
data ObjectField = ObjectField
|
||||
{ name :: Full.Name
|
||||
, value :: Full.Node Value
|
||||
, value :: Full.Node Input
|
||||
, location :: Full.Location
|
||||
}
|
||||
|
||||
|
|
@ -192,10 +195,10 @@ selectionSet :: Full.SelectionSet -> Transform SelectionSet
|
|||
selectionSet = selectionSetOpt . NonEmpty.toList
|
||||
|
||||
selectionSetOpt :: Full.SelectionSetOpt -> Transform SelectionSet
|
||||
selectionSetOpt = foldM go []
|
||||
selectionSetOpt = foldM go Seq.empty
|
||||
where
|
||||
go accumulatedSelections currentSelection =
|
||||
selection currentSelection <&> (accumulatedSelections ++)
|
||||
selection currentSelection <&> (accumulatedSelections ><)
|
||||
|
||||
selection :: Full.Selection -> Transform SelectionSet
|
||||
selection (Full.FieldSelection field') =
|
||||
|
|
@ -209,7 +212,7 @@ maybeToSelectionSet :: forall a
|
|||
. (a -> Selection)
|
||||
-> Transform (Maybe a)
|
||||
-> Transform SelectionSet
|
||||
maybeToSelectionSet selectionType = fmap (maybe [] $ pure . selectionType)
|
||||
maybeToSelectionSet selectionType = fmap (maybe Seq.empty $ pure . selectionType)
|
||||
|
||||
directives :: [Full.Directive] -> Transform (Maybe [Type.Directive])
|
||||
directives = fmap Type.selection . traverse directive
|
||||
|
|
@ -226,13 +229,13 @@ inlineFragment (Full.InlineFragment maybeCondition directives' selectionSet' loc
|
|||
pure $ case transformedDirectives >> maybeFragmentType of
|
||||
Just fragmentType -> Right
|
||||
$ Fragment fragmentType transformedSelections location
|
||||
Nothing -> Left []
|
||||
Nothing -> Left Seq.empty
|
||||
| otherwise = do
|
||||
transformedSelections <- selectionSet selectionSet'
|
||||
transformedDirectives <- directives directives'
|
||||
pure $ if isJust transformedDirectives
|
||||
then Left transformedSelections
|
||||
else Left []
|
||||
else Left Seq.empty
|
||||
|
||||
fragmentSpread :: Full.FragmentSpread -> Transform (Maybe Fragment)
|
||||
fragmentSpread (Full.FragmentSpread spreadName directives' location) = do
|
||||
|
|
@ -260,7 +263,6 @@ fragmentSpread (Full.FragmentSpread spreadName directives' location) = do
|
|||
fragmentInserter replacement@Replacement{ visitedFragments } = replacement
|
||||
{ visitedFragments = HashSet.insert spreadName visitedFragments }
|
||||
|
||||
|
||||
field :: Full.Field -> Transform (Maybe Field)
|
||||
field (Full.Field alias' name' arguments' directives' selectionSet' location') = do
|
||||
transformedSelections <- selectionSetOpt selectionSet'
|
||||
|
|
@ -309,7 +311,7 @@ directiveValue = \case
|
|||
transformedValue <- directiveNode value
|
||||
pure $ HashMap.insert name transformedValue accumulator
|
||||
|
||||
variableValue :: Full.Value -> Value
|
||||
variableValue :: Full.Value -> Input
|
||||
variableValue (Full.Variable name') = Variable name'
|
||||
variableValue (Full.Int integer) = Int integer
|
||||
variableValue (Full.Float double) = Float double
|
||||
|
|
@ -327,7 +329,7 @@ variableValue (Full.Object objectFields) = Object $ objectField <$> objectFields
|
|||
, location = location
|
||||
}
|
||||
|
||||
node :: Full.Node Full.Value -> Full.Node Value
|
||||
node :: Full.Node Full.Value -> Full.Node Input
|
||||
node Full.Node{node = node', ..} = Full.Node (variableValue node') location
|
||||
|
||||
executeRequest :: Schema IO
|
||||
|
|
@ -411,9 +413,39 @@ executeSelectionSet
|
|||
-> Aeson.Object
|
||||
-> Type.Subs
|
||||
-> Aeson.Object
|
||||
executeSelectionSet selections objectType _objectValue _variableValues =
|
||||
let _groupedFieldSet = collectFields objectType selections
|
||||
in mempty
|
||||
executeSelectionSet selections objectType objectValue variableValues =
|
||||
let groupedFieldSet = collectFields objectType selections
|
||||
in OrderedMap.foldlWithKey' go mempty groupedFieldSet
|
||||
where
|
||||
Out.ObjectType _ _ _ resolvers = objectType
|
||||
executeField' fields resolver =
|
||||
executeField objectType objectValue fields resolver variableValues
|
||||
go resultMap responseKey fields@(Field _ fieldName _ _ _ :| _) =
|
||||
case HashMap.lookup fieldName resolvers of
|
||||
Just resolver ->
|
||||
let responseValue = executeField' fields resolver
|
||||
in HashMap.insert responseKey responseValue resultMap
|
||||
Nothing -> resultMap
|
||||
|
||||
executeField :: Out.ObjectType IO
|
||||
-> Aeson.Object
|
||||
-> NonEmpty Field
|
||||
-> Out.Resolver IO
|
||||
-> Type.Subs
|
||||
-> Aeson.Value
|
||||
executeField _objectType _objectValue fields fieldType _variableValues =
|
||||
let _field'@(Field _ _fieldName inputArguments _ _) :| _ = fields
|
||||
Out.Field _ _ argumentTypes = resolverField fieldType
|
||||
_argumentValues = coerceArgumentValues argumentTypes inputArguments
|
||||
in Aeson.Null
|
||||
where
|
||||
resolverField (Out.ValueResolver resolverField' _) = resolverField'
|
||||
resolverField (Out.EventStreamResolver resolverField' _ _) = resolverField'
|
||||
|
||||
coerceArgumentValues :: HashMap Full.Name In.Argument
|
||||
-> [Argument]
|
||||
-> Either [Full.Location] Type.Subs
|
||||
coerceArgumentValues _argumentDefinitions _argumentNodes = pure mempty
|
||||
|
||||
collectFields :: Out.ObjectType IO
|
||||
-> SelectionSet
|
||||
|
|
|
|||
Loading…
Reference in New Issue