diff options
Diffstat (limited to 'src/Language/GraphQL/Execute/Transform.hs')
| -rw-r--r-- | src/Language/GraphQL/Execute/Transform.hs | 26 |
1 files changed, 16 insertions, 10 deletions
diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index 733ac8c..76d1fe7 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -44,12 +44,11 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Language.GraphQL.AST as Full import Language.GraphQL.AST (Name) -import Language.GraphQL.AST.Core import qualified Language.GraphQL.Execute.Coerce as Coerce -import Language.GraphQL.Type.Directive (Directive(..)) -import qualified Language.GraphQL.Type.Directive as Directive +import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type as Type import qualified Language.GraphQL.Type.In as In +import Language.GraphQL.Type.Internal import qualified Language.GraphQL.Type.Out as Out import Language.GraphQL.Type.Schema @@ -78,6 +77,7 @@ data Selection m data Operation m = Query (Maybe Text) (Seq (Selection m)) | Mutation (Maybe Text) (Seq (Selection m)) + | Subscription (Maybe Text) (Seq (Selection m)) -- | Single GraphQL field. data Field m = Field @@ -239,6 +239,10 @@ document schema operationName subs ast = do | Just mutationType <- mutation schema -> pure $ Document referencedTypes mutationType $ operation chosenOperation replacement + OperationDefinition Full.Subscription _ _ _ _ + | Just subscriptionType <- subscription schema -> + pure $ Document referencedTypes subscriptionType + $ operation chosenOperation replacement _ -> Left UnsupportedRootOperation defragment @@ -251,10 +255,10 @@ defragment ast = in (, fragmentTable) <$> maybe emptyDocument Right nonEmptyOperations where defragment' definition (operations, fragments') - | (Full.ExecutableDefinition executable) <- definition + | (Full.ExecutableDefinition executable _) <- definition , (Full.DefinitionOperation operation') <- executable = (transform operation' : operations, fragments') - | (Full.ExecutableDefinition executable) <- definition + | (Full.ExecutableDefinition executable _) <- definition , (Full.DefinitionFragment fragment) <- executable , (Full.FragmentDefinition name _ _ _) <- fragment = (operations, HashMap.insert name fragment fragments') @@ -276,6 +280,8 @@ operation operationDefinition replacement Query name <$> appendSelection sels transform (OperationDefinition Full.Mutation name _ _ sels) = Mutation name <$> appendSelection sels + transform (OperationDefinition Full.Subscription name _ _ sels) = + Subscription name <$> appendSelection sels -- * Selection @@ -286,7 +292,7 @@ selection (Full.Field alias name arguments' directives' selections) = maybe (Left mempty) (Right . SelectionField) <$> do fieldArguments <- foldM go HashMap.empty arguments' fieldSelections <- appendSelection selections - fieldDirectives <- Directive.selection <$> directives directives' + fieldDirectives <- Definition.selection <$> directives directives' let field' = Field alias name fieldArguments fieldSelections pure $ field' <$ fieldDirectives where @@ -295,7 +301,7 @@ selection (Full.Field alias name arguments' directives' selections) = selection (Full.FragmentSpread name directives') = maybe (Left mempty) (Right . SelectionFragment) <$> do - spreadDirectives <- Directive.selection <$> directives directives' + spreadDirectives <- Definition.selection <$> directives directives' fragments' <- gets fragments fragmentDefinitions' <- gets fragmentDefinitions @@ -309,7 +315,7 @@ selection (Full.FragmentSpread name directives') = _ -> lift $ pure Nothing | otherwise -> lift $ pure Nothing selection (Full.InlineFragment type' directives' selections) = do - fragmentDirectives <- Directive.selection <$> directives directives' + fragmentDirectives <- Definition.selection <$> directives directives' case fragmentDirectives of Nothing -> pure $ Left mempty _ -> do @@ -337,11 +343,11 @@ appendSelection = foldM go mempty append acc (Left list) = list >< acc append acc (Right one) = one <| acc -directives :: [Full.Directive] -> State (Replacement m) [Directive] +directives :: [Full.Directive] -> State (Replacement m) [Definition.Directive] directives = traverse directive where directive (Full.Directive directiveName directiveArguments) - = Directive directiveName . Arguments + = Definition.Directive directiveName . Type.Arguments <$> foldM go HashMap.empty directiveArguments go arguments (Full.Argument name value') = do substitutedValue <- value value' |