diff options
| author | Eugen Wissner <belka@caraus.de> | 2023-02-26 09:43:43 +0100 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2023-02-26 09:43:43 +0100 |
| commit | 2834360411d41f8d7cb22d914d5cb914d928d51f (patch) | |
| tree | 00f47e28747e3fa8f32f1582a29f12922f8fdac9 /src/Language | |
| parent | 83f2dc1a2d4820a9d58618ff4d3724db420fe3b6 (diff) | |
| download | graphql-2834360411d41f8d7cb22d914d5cb914d928d51f.tar.gz | |
Remove JSON support in the core package
Diffstat (limited to 'src/Language')
| -rw-r--r-- | src/Language/GraphQL.hs | 101 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute/Coerce.hs | 76 |
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 |
