summaryrefslogtreecommitdiff
path: root/src/Language
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language')
-rw-r--r--src/Language/GraphQL/Foundation.hs58
-rw-r--r--src/Language/GraphQL/JSON.hs (renamed from src/Language/GraphQL/Serialize.hs)57
2 files changed, 54 insertions, 61 deletions
diff --git a/src/Language/GraphQL/Foundation.hs b/src/Language/GraphQL/Foundation.hs
deleted file mode 100644
index 4d0d4f3..0000000
--- a/src/Language/GraphQL/Foundation.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
-
-module Language.GraphQL.Foundation
- ( module Language.GraphQL.Serialize
- , graphql
- ) where
-
-import Language.GraphQL.Serialize
-import Control.Monad.Catch (MonadCatch)
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Types as Aeson
-import Data.HashMap.Strict (HashMap)
-import qualified Data.Aeson.KeyMap as KeyMap
-import Data.Maybe (catMaybes)
-import qualified Data.Sequence as Seq
-import Data.Text (Text)
-import Data.Vector (Vector)
-import qualified Data.Vector as Vector
-import qualified Language.GraphQL as GraphQL
-import Language.GraphQL.AST
-import Language.GraphQL.Error
-import Language.GraphQL.Type.Schema (Schema)
-import Data.Bifunctor (Bifunctor(..))
-
--- | If the text parses correctly as a @GraphQL@ query the query is
--- executed using the given 'Schema'.
-graphql :: MonadCatch m
- => Schema m -- ^ Resolvers.
- -> Text -- ^ Text representing a @GraphQL@ request document.
- -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
-graphql schema = fmap (bimap stream formatResponse)
- . GraphQL.graphql schema mempty (mempty :: HashMap Name JSON)
- where
- stream :: ResponseEventStream m JSON -> ResponseEventStream m Aeson.Value
- stream = undefined
- formatResponse :: Response JSON -> Aeson.Object
- formatResponse Response{ errors, data' = JSON json } =
- let dataResponse = KeyMap.singleton "data" json
- in case errors of
- Seq.Empty -> dataResponse
- _ -> flip (KeyMap.insert "errors") dataResponse
- $ Aeson.Array $ foldr fromError mempty errors
- fromError :: Error -> Vector Aeson.Value -> Vector Aeson.Value
- fromError Error{..} = Vector.cons $ Aeson.object $ catMaybes
- [ Just ("message", Aeson.String message)
- , toMaybe fromLocation "locations" locations
- , toMaybe fromPath "path" path
- ]
- fromPath (Segment segment) = Aeson.String segment
- fromPath (Index index) = Aeson.toJSON index
- fromLocation Location{..} = Aeson.object
- [ ("line", Aeson.toJSON line)
- , ("column", Aeson.toJSON column)
- ]
- toMaybe _ _ [] = Nothing
- toMaybe f key xs = Just (key, Aeson.listValue f xs)
diff --git a/src/Language/GraphQL/Serialize.hs b/src/Language/GraphQL/JSON.hs
index cad4f47..bdbc4f4 100644
--- a/src/Language/GraphQL/Serialize.hs
+++ b/src/Language/GraphQL/JSON.hs
@@ -1,17 +1,30 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
-module Language.GraphQL.Serialize
+module Language.GraphQL.JSON
( JSON(..)
+ , graphql
) where
-import qualified Data.Aeson as Aeson
+import Control.Monad.Catch (MonadCatch)
+import qualified Data.Aeson.Types as Aeson
+import Data.Maybe (catMaybes)
+import qualified Data.Sequence as Seq
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import qualified Language.GraphQL as GraphQL
+import Language.GraphQL.AST (Location(..), Name)
+import Language.GraphQL.Error
+import Language.GraphQL.Type.Schema (Schema)
+import Data.Bifunctor (Bifunctor(..))
+import qualified Conduit
import qualified Data.Aeson.Key as Aeson.Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Scientific (toBoundedInteger, toRealFloat)
import Data.Text (Text)
-import Language.GraphQL.AST (Name)
import Language.GraphQL.Execute.Coerce
import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
import qualified Language.GraphQL.Type.In as In
@@ -100,3 +113,41 @@ instance VariableValue JSON where
coerced <- coerceVariableValue listType $ JSON variableValue
pure $ coerced : list
coerceVariableValue _ _ = Nothing
+
+-- | If the text parses correctly as a @GraphQL@ query the query is
+-- executed using the given 'Schema'.
+graphql :: MonadCatch m
+ => Schema m -- ^ Resolvers.
+ -> Maybe Text -- ^ Operation name.
+ -> Aeson.Object -- ^ Variables.
+ -> Text -- ^ Text representing a @GraphQL@ request document.
+ -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
+graphql schema operationName variableValues = fmap (bimap stream formatResponse)
+ . GraphQL.graphql schema operationName jsonVariables
+ where
+ jsonVariables = JSON <$> KeyMap.toHashMapText variableValues
+ -- stream :: ResponseEventStream m JSON -> ResponseEventStream m Aeson.Value
+ stream = Conduit.mapOutput mapResponse
+ mapResponse response@Response{ data' = JSON json } =
+ response{ data' = json }
+ formatResponse :: Response JSON -> Aeson.Object
+ formatResponse Response{ errors, data' = JSON json } =
+ let dataResponse = KeyMap.singleton "data" json
+ in case errors of
+ Seq.Empty -> dataResponse
+ _ -> flip (KeyMap.insert "errors") dataResponse
+ $ Aeson.Array $ foldr fromError mempty errors
+ fromError :: Error -> Vector Aeson.Value -> Vector Aeson.Value
+ fromError Error{..} = Vector.cons $ Aeson.object $ catMaybes
+ [ Just ("message", Aeson.String message)
+ , toMaybe fromLocation "locations" locations
+ , toMaybe fromPath "path" path
+ ]
+ fromPath (Segment segment) = Aeson.String segment
+ fromPath (Index index) = Aeson.toJSON index
+ fromLocation Location{..} = Aeson.object
+ [ ("line", Aeson.toJSON line)
+ , ("column", Aeson.toJSON column)
+ ]
+ toMaybe _ _ [] = Nothing
+ toMaybe f key xs = Just (key, Aeson.listValue f xs)