summaryrefslogtreecommitdiff
path: root/src/Language
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2023-02-26 09:43:43 +0100
committerEugen Wissner <belka@caraus.de>2023-02-26 09:43:43 +0100
commit2834360411d41f8d7cb22d914d5cb914d928d51f (patch)
tree00f47e28747e3fa8f32f1582a29f12922f8fdac9 /src/Language
parent83f2dc1a2d4820a9d58618ff4d3724db420fe3b6 (diff)
downloadgraphql-2834360411d41f8d7cb22d914d5cb914d928d51f.tar.gz
Remove JSON support in the core package
Diffstat (limited to 'src/Language')
-rw-r--r--src/Language/GraphQL.hs101
-rw-r--r--src/Language/GraphQL/Execute/Coerce.hs76
2 files changed, 0 insertions, 177 deletions
diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs
index 4f3e8d9..949fd06 100644
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@@ -1,105 +1,5 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
-#ifdef WITH_JSON
--- | This module provides the functions to parse and execute @GraphQL@ queries.
---
--- The content of this module depends on the value of the __json__ flag, which
--- is currently on by default. This behavior will change in the future, the flag
--- will be switched off by default and then removed.
---
--- This documentation is generated with the enabled __json__ flag and functions
--- described here support JSON and are deprecated. JSON instances are provided
--- now by an additional package, __graphql-spice__. To start using the new
--- package create __cabal.project__ in the root directory of your project with
--- the following contents:
---
--- @
--- packages: .
--- constraints: graphql -json
--- @
---
--- Then add __graphql-spice__ as dependency.
---
--- The new version of this module defines only one function, @graphql@, which
--- works with the internal GraphQL value representation used by this lbirary.
--- Refer to @Language.GraphQL.JSON.graphql@ in __graphql-spice__ for the
--- function that accepts and returns JSON.
-module Language.GraphQL
- ( graphql
- , graphqlSubs
- ) where
-
-import Control.Monad.Catch (MonadCatch)
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Types as Aeson
-import qualified Data.HashMap.Strict as HashMap
-import Data.Maybe (catMaybes)
-import qualified Data.Sequence as Seq
-import Data.Text (Text)
-import Language.GraphQL.AST
-import Language.GraphQL.Error
-import Language.GraphQL.Execute
-import qualified Language.GraphQL.Validate as Validate
-import Language.GraphQL.Type.Schema (Schema)
-import Text.Megaparsec (parse)
-
-{-# DEPRECATED graphql "Use graphql-spice package instead" #-}
--- | 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 = graphqlSubs schema mempty mempty
-
-{-# DEPRECATED graphqlSubs "Use graphql-spice package instead" #-}
--- | If the text parses correctly as a @GraphQL@ query the substitution is
--- applied to the query and the query is then executed using to the given
--- 'Schema'.
-graphqlSubs :: MonadCatch m
- => Schema m -- ^ Resolvers.
- -> Maybe Text -- ^ Operation name.
- -> Aeson.Object -- ^ Variable substitution function.
- -> Text -- ^ Text representing a @GraphQL@ request document.
- -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
-graphqlSubs schema operationName variableValues document' =
- case parse document "" document' of
- Left errorBundle -> pure . formatResponse <$> parseError errorBundle
- Right parsed ->
- case validate parsed of
- Seq.Empty -> fmap formatResponse
- <$> execute schema operationName variableValues parsed
- errors -> pure $ pure
- $ HashMap.singleton "errors"
- $ Aeson.toJSON
- $ fromValidationError <$> errors
- where
- validate = Validate.document schema Validate.specifiedRules
- formatResponse (Response data'' Seq.Empty) = HashMap.singleton "data" data''
- formatResponse (Response data'' errors') = HashMap.fromList
- [ ("data", data'')
- , ("errors", Aeson.toJSON $ fromError <$> errors')
- ]
- fromError Error{..} = Aeson.object $ catMaybes
- [ Just ("message", Aeson.toJSON message)
- , toMaybe fromLocation "locations" locations
- , toMaybe fromPath "path" path
- ]
- fromValidationError Validate.Error{..} = Aeson.object
- [ ("message", Aeson.toJSON message)
- , ("locations", Aeson.listValue fromLocation locations)
- ]
- toMaybe _ _ [] = Nothing
- toMaybe f key xs = Just (key, Aeson.listValue f xs)
- fromPath (Segment segment) = Aeson.String segment
- fromPath (Index index) = Aeson.toJSON index
- fromLocation Location{..} = Aeson.object
- [ ("line", Aeson.toJSON line)
- , ("column", Aeson.toJSON column)
- ]
-#else
-- | This module provides the functions to parse and execute @GraphQL@ queries.
module Language.GraphQL
( graphql
@@ -144,4 +44,3 @@ graphql schema operationName variableValues document' =
, locations = locations
, path = []
}
-#endif
diff --git a/src/Language/GraphQL/Execute/Coerce.hs b/src/Language/GraphQL/Execute/Coerce.hs
index 4725d74..54fc1c1 100644
--- a/src/Language/GraphQL/Execute/Coerce.hs
+++ b/src/Language/GraphQL/Execute/Coerce.hs
@@ -5,14 +5,8 @@
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE CPP #-}
-- | Types and functions used for input and result coercion.
---
--- JSON instances in this module are only available with the __json__
--- flag that is currently on by default, but will be disabled in the future.
--- Refer to the documentation in the 'Language.GraphQL' module and to
--- the __graphql-spice__ package.
module Language.GraphQL.Execute.Coerce
( Output(..)
, Serialize(..)
@@ -21,10 +15,6 @@ module Language.GraphQL.Execute.Coerce
, matchFieldValues
) where
-#ifdef WITH_JSON
-import qualified Data.Aeson as Aeson
-import Data.Scientific (toBoundedInteger, toRealFloat)
-#endif
import Data.Int (Int32)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
@@ -232,69 +222,3 @@ instance Serialize Type.Value where
$ HashMap.fromList
$ OrderedMap.toList object
serialize _ _ = Nothing
-
-#ifdef WITH_JSON
-instance Serialize Aeson.Value where
- serialize (Out.ScalarBaseType scalarType) value
- | Type.ScalarType "Int" _ <- scalarType
- , Int int <- value = Just $ Aeson.toJSON int
- | Type.ScalarType "Float" _ <- scalarType
- , Float float <- value = Just $ Aeson.toJSON float
- | Type.ScalarType "String" _ <- scalarType
- , String string <- value = Just $ Aeson.String string
- | Type.ScalarType "ID" _ <- scalarType
- , String string <- value = Just $ Aeson.String string
- | Type.ScalarType "Boolean" _ <- scalarType
- , Boolean boolean <- value = Just $ Aeson.Bool boolean
- serialize _ (Enum enum) = Just $ Aeson.String enum
- serialize _ (List list) = Just $ Aeson.toJSON list
- serialize _ (Object object) = Just
- $ Aeson.object
- $ OrderedMap.toList
- $ Aeson.toJSON <$> object
- serialize _ _ = Nothing
- null = Aeson.Null
-
-instance VariableValue Aeson.Value where
- coerceVariableValue _ Aeson.Null = Just Type.Null
- coerceVariableValue (In.ScalarBaseType scalarType) value
- | (Aeson.String stringValue) <- value = Just $ Type.String stringValue
- | (Aeson.Bool booleanValue) <- value = Just $ Type.Boolean booleanValue
- | (Aeson.Number numberValue) <- value
- , (Type.ScalarType "Float" _) <- scalarType =
- Just $ Type.Float $ toRealFloat numberValue
- | (Aeson.Number numberValue) <- value = -- ID or Int
- Type.Int <$> toBoundedInteger numberValue
- coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
- Just $ Type.Enum stringValue
- coerceVariableValue (In.InputObjectBaseType objectType) value
- | (Aeson.Object objectValue) <- value = do
- let (In.InputObjectType _ _ inputFields) = objectType
- (newObjectValue, resultMap) <- foldWithKey objectValue inputFields
- if HashMap.null newObjectValue
- then Just $ Type.Object resultMap
- else Nothing
- where
- foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues'
- $ Just (objectValue, HashMap.empty)
- matchFieldValues' _ _ Nothing = Nothing
- matchFieldValues' fieldName inputField (Just (objectValue, resultMap)) =
- let (In.InputField _ fieldType _) = inputField
- insert = flip (HashMap.insert fieldName) resultMap
- newObjectValue = HashMap.delete fieldName objectValue
- in case HashMap.lookup fieldName objectValue of
- Just variableValue -> do
- coerced <- coerceVariableValue fieldType variableValue
- pure (newObjectValue, insert coerced)
- Nothing -> Just (objectValue, resultMap)
- coerceVariableValue (In.ListBaseType listType) value
- | (Aeson.Array arrayValue) <- value =
- Type.List <$> foldr foldVector (Just []) arrayValue
- | otherwise = coerceVariableValue listType value
- where
- foldVector _ Nothing = Nothing
- foldVector variableValue (Just list) = do
- coerced <- coerceVariableValue listType variableValue
- pure $ coerced : list
- coerceVariableValue _ _ = Nothing
-#endif