Add back graphql function, but jsonless

1 files changed, 42 insertions, 3 deletions

diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs
index 20bb123..b64cf42 100644
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@@ -1,9 +1,8 @@
 {-# LANGUAGE CPP #-}
-
-#ifdef WITH_JSON
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
+#ifdef WITH_JSON
 -- | This module provides the functions to parse and execute @GraphQL@ queries.
 module Language.GraphQL
     ( graphql
@@ -79,6 +78,46 @@ graphqlSubs schema operationName variableValues document' =
 #else
 -- | This module provides the functions to parse and execute @GraphQL@ queries.
 module Language.GraphQL
-    (
+    ( graphql
     ) where
+
+import Control.Monad.Catch (MonadCatch)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.Sequence as Seq
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Language.GraphQL.AST as Full
+import Language.GraphQL.Error
+import Language.GraphQL.Execute
+import qualified Language.GraphQL.Validate as Validate
+import Language.GraphQL.Type.Schema (Schema)
+import Prelude hiding (null)
+import Text.Megaparsec (parse)
+
+-- | If the text parses correctly as a @GraphQL@ query the query is
+-- executed using the given 'Schema'.
+--
+-- An operation name can be given if the document contains multiple operations.
+graphql :: (MonadCatch m, VariableValue a, Serialize b)
+    => Schema m -- ^ Resolvers.
+    -> Maybe Text -- ^ Operation name.
+    -> HashMap Full.Name a -- ^ Variable substitution function.
+    -> Text -- ^ Text representing a @GraphQL@ request document.
+    -> m (Either (ResponseEventStream m b) (Response b)) -- ^ Response.
+graphql schema operationName variableValues document' =
+    case parse Full.document "" document' of
+        Left errorBundle -> pure  <$> parseError errorBundle
+        Right parsed ->
+            case validate parsed of
+                Seq.Empty -> execute schema operationName variableValues parsed
+                errors -> pure $ pure
+                    $ Response null
+                    $ fromValidationError <$> errors
+  where
+    validate = Validate.document schema Validate.specifiedRules
+    fromValidationError Validate.Error{..} = Error
+        { message = Text.pack message
+        , locations = locations
+        , path = []
+        }
 #endif