Stub request execution

src/Language/GraphQL/Executor.hs

@@ -2,7 +2,9 @@
    v. 2.0. If a copy of the MPL was not distributed with this file, You can
    obtain one at https://mozilla.org/MPL/2.0/. -}
 
+{-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Language.GraphQL.Executor
    ( Error(..)
@@ -10,14 +12,20 @@ module Language.GraphQL.Executor
    , QueryError(..)
    , Response(..)
    , Segment(..)
+   , coerceVariableValues
    , executeRequest
    ) where
 
 import qualified Language.GraphQL.AST.Document as Full
 import qualified Data.Aeson as Aeson
 import Data.Foldable (find)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Text as Text
+import qualified Language.GraphQL.Execute.Coerce as Coerce
+import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.Internal as Type.Internal
+import qualified Language.GraphQL.Type.Schema as Schema
 
 data Segment = Segment String | Index Int
 
@@ -35,11 +43,13 @@ data Response = Response
 data QueryError
    = OperationNameRequired
    | OperationNotFound String
+   | CoercionError
 
 instance Show QueryError where
     show OperationNameRequired = "Operation name is required."
     show (OperationNotFound operationName) =
         concat ["Operation \"",  operationName, "\" not found."]
+    show CoercionError = "Coercion error."
 
 respondWithQueryError :: QueryError -> Response
 respondWithQueryError queryError
@@ -82,7 +92,9 @@ executeRequest _schema sourceDocument operationName _variableValues _initialValu
        operation = getOperation transformedDocument operationName
     in case operation of
         Left queryError -> pure $ respondWithQueryError queryError
-        Right _ -> pure $ Response mempty mempty
+        Right (Operation Full.Query _ _ _ _) -> executeQuery
+        Right (Operation Full.Mutation _ _ _ _) -> executeMutation
+        Right (Operation Full.Subscription _ _ _ _) -> subscribe
 
 getOperation :: [Operation] -> Maybe String -> Either QueryError Operation
 getOperation [operation] Nothing = Right operation
@@ -94,3 +106,54 @@ getOperation operations (Just givenOperationName)
         givenOperationName == operationName
     findOperationByName _ = False
 getOperation _ _ = Left OperationNameRequired
+
+executeQuery :: IO Response
+executeQuery = pure $ Response mempty mempty
+
+executeMutation :: IO Response
+executeMutation = pure $ Response mempty mempty
+
+subscribe :: IO Response
+subscribe = pure $ Response mempty mempty
+
+coerceVariableValues :: Coerce.VariableValue a
+    => forall m
+    . HashMap Full.Name (Schema.Type m)
+    -> Operation
+    -> HashMap Full.Name a
+    -> Either QueryError Type.Subs
+coerceVariableValues types operationDefinition' variableValues =
+    let Operation _ _ variableDefinitions _ _ = operationDefinition'
+     in maybe (Left CoercionError) Right
+        $ foldr forEach (Just HashMap.empty) variableDefinitions
+  where
+    forEach variableDefinition coercedValues = do
+        let Full.VariableDefinition variableName variableTypeName defaultValue _ =
+                variableDefinition
+        let defaultValue' = constValue . Full.node <$> defaultValue
+        variableType <- Type.Internal.lookupInputType variableTypeName types
+
+        Coerce.matchFieldValues
+            coerceVariableValue'
+            variableValues
+            variableName
+            variableType
+            defaultValue'
+            coercedValues
+    coerceVariableValue' variableType value'
+        = Coerce.coerceVariableValue variableType value'
+        >>= Coerce.coerceInputLiteral variableType
+
+constValue :: Full.ConstValue -> Type.Value
+constValue (Full.ConstInt i) = Type.Int i
+constValue (Full.ConstFloat f) = Type.Float f
+constValue (Full.ConstString x) = Type.String x
+constValue (Full.ConstBoolean b) = Type.Boolean b
+constValue Full.ConstNull = Type.Null
+constValue (Full.ConstEnum e) = Type.Enum e
+constValue (Full.ConstList list) = Type.List $ constValue . Full.node <$> list
+constValue (Full.ConstObject o) =
+    Type.Object $ HashMap.fromList $ constObjectField <$> o
+  where
+    constObjectField Full.ObjectField{value = value', ..} =
+        (name, constValue $ Full.node value')