summaryrefslogtreecommitdiff
path: root/Data/GraphQL/Execute.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Data/GraphQL/Execute.hs')
-rw-r--r--Data/GraphQL/Execute.hs44
1 files changed, 25 insertions, 19 deletions
diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs
index 01fc118..9d20e5c 100644
--- a/Data/GraphQL/Execute.hs
+++ b/Data/GraphQL/Execute.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE LambdaCase #-}
module Data.GraphQL.Execute where
#if !MIN_VERSION_base(4,8,0)
@@ -8,6 +7,7 @@ import Data.Traversable (traverse)
#endif
import Control.Applicative (Alternative, empty)
import Data.Foldable (fold)
+import Data.Maybe (catMaybes)
import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
@@ -16,31 +16,37 @@ import Data.GraphQL.AST
import Data.GraphQL.Schema (Resolver, Schema(..))
import qualified Data.GraphQL.Schema as Schema
-execute :: (Alternative m, Monad m) => Schema m -> Document -> m Aeson.Value
-execute (Schema resolv) doc = selectionSet resolv =<< query doc
+execute :: (Alternative m, Monad m) => Schema m -> Schema.Subs -> Document -> m Aeson.Value
+execute (Schema resolv) f doc = selectionSet f resolv =<< query doc
query :: Alternative f => Document -> f SelectionSet
-query (Document [DefinitionOperation (Query (Node _ _ _ sels))]) = pure sels
-query _ = empty
+query (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
+ pure sels
+query _ = empty
-selectionSet :: Alternative f => Resolver f -> SelectionSet -> f Aeson.Value
-selectionSet resolv = fmap (Aeson.Object . fold) . traverse (selection resolv)
+selectionSet :: Alternative f => Schema.Subs -> Resolver f -> SelectionSet -> f Aeson.Value
+selectionSet f resolv = fmap (Aeson.Object . fold) . traverse (selection f resolv)
-selection :: Alternative f => Resolver f -> Selection -> f Aeson.Object
-selection resolv (SelectionField field@(Field _ name _ _ _)) =
- fmap (HashMap.singleton name) $ Aeson.toJSON <$> resolv (fieldToInput field)
-selection _ _ = empty
+selection :: Alternative f => Schema.Subs -> Resolver f -> Selection -> f Aeson.Object
+selection f resolv (SelectionField field@(Field _ name _ _ _)) =
+ fmap (HashMap.singleton name) $ Aeson.toJSON <$> resolv (fieldToInput f field)
+selection _ _ _ = empty
-- * AST/Schema conversions
-argument :: Argument -> Schema.Argument
-argument (Argument n (ValueInt v)) = (n, Schema.ScalarInt $ fromIntegral v)
-argument (Argument n (ValueString (StringValue v))) = (n, Schema.ScalarString v)
-argument _ = error "argument: not implemented yet"
-
-fieldToInput :: Field -> Schema.Input
-fieldToInput (Field _ n as _ sels) =
- Schema.InputField n (argument <$> as) (fieldToInput . selectionToField <$> sels)
+argument :: Schema.Subs -> Argument -> Maybe Schema.Argument
+argument f (Argument n (ValueVariable (Variable v))) =
+ maybe Nothing (\v' -> Just (n, v')) $ f v
+argument _ (Argument n (ValueInt v)) =
+ Just (n, Schema.ScalarInt $ fromIntegral v)
+argument _ (Argument n (ValueString (StringValue v))) =
+ Just (n, Schema.ScalarString v)
+argument _ _ = error "argument: not implemented yet"
+
+fieldToInput :: Schema.Subs -> Field -> Schema.Input
+fieldToInput f (Field _ n as _ sels) =
+ Schema.InputField n (catMaybes $ argument f <$> as)
+ (fieldToInput f . selectionToField <$> sels)
selectionToField :: Selection -> Field
selectionToField (SelectionField x) = x