Remove JSON support in the core package

This commit is contained in:
Eugen Wissner 2023-02-26 09:43:43 +01:00
parent 83f2dc1a2d
commit 2834360411
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
5 changed files with 9 additions and 241 deletions

View File

@ -10,10 +10,17 @@ and this project adheres to
### Added ### Added
- Schema printing. - Schema printing.
- `Semigroup` and `Monoid` instances for `AST.Document.Description`. - `Semigroup` and `Monoid` instances for `AST.Document.Description`.
- Support for vector 0.13.0.0 and transformers 0.6.1.0.
### Fixed ### Fixed
- Fix resolvers returning a list in the reverse order. - Fix resolvers returning a list in the reverse order.
### Removed
- GHC 8 support.
- Cabal -json flag.
- `Test.Hspec.GraphQL`: moved to `graphql-spice` package.
- CPP `ifdef WITH_JSON` blocks.
## [1.1.0.0] - 2022-12-24 ## [1.1.0.0] - 2022-12-24
### Changed ### Changed
- Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`, - Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`,

View File

@ -21,18 +21,12 @@ extra-source-files:
CHANGELOG.md CHANGELOG.md
README.md README.md
tested-with: tested-with:
GHC == 8.10.7,
GHC == 9.2.4 GHC == 9.2.4
source-repository head source-repository head
type: git type: git
location: git://caraus.tech/pub/graphql.git location: git://caraus.tech/pub/graphql.git
flag Json
description: Whether to build against @aeson 1.x@
default: False
manual: True
library library
exposed-modules: exposed-modules:
Language.GraphQL Language.GraphQL
@ -53,7 +47,6 @@ library
Language.GraphQL.Type.Schema Language.GraphQL.Type.Schema
Language.GraphQL.Validate Language.GraphQL.Validate
Language.GraphQL.Validate.Validation Language.GraphQL.Validate.Validation
Test.Hspec.GraphQL
other-modules: other-modules:
Language.GraphQL.Execute.Transform Language.GraphQL.Execute.Transform
Language.GraphQL.Type.Definition Language.GraphQL.Type.Definition
@ -72,15 +65,9 @@ library
parser-combinators >= 1.3 && < 2, parser-combinators >= 1.3 && < 2,
template-haskell >= 2.16 && < 3, template-haskell >= 2.16 && < 3,
text >= 1.2 && < 3, text >= 1.2 && < 3,
transformers ^>= 0.5.6, transformers >= 0.5.6 && < 0.7,
unordered-containers ^>= 0.2.14, unordered-containers ^>= 0.2.14,
vector ^>= 0.12.3 vector >= 0.12 && < 0.14
if flag(Json)
build-depends:
aeson >= 1.5.6 && < 1.6,
hspec-expectations >= 0.8.2 && < 0.9,
scientific >= 0.3.7 && < 0.4
cpp-options: -DWITH_JSON
default-language: Haskell2010 default-language: Haskell2010

View File

@ -1,105 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# 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. -- | This module provides the functions to parse and execute @GraphQL@ queries.
module Language.GraphQL module Language.GraphQL
( graphql ( graphql
@ -144,4 +44,3 @@ graphql schema operationName variableValues document' =
, locations = locations , locations = locations
, path = [] , path = []
} }
#endif

View File

@ -5,14 +5,8 @@
{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
-- | Types and functions used for input and result coercion. -- | 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 module Language.GraphQL.Execute.Coerce
( Output(..) ( Output(..)
, Serialize(..) , Serialize(..)
@ -21,10 +15,6 @@ module Language.GraphQL.Execute.Coerce
, matchFieldValues , matchFieldValues
) where ) where
#ifdef WITH_JSON
import qualified Data.Aeson as Aeson
import Data.Scientific (toBoundedInteger, toRealFloat)
#endif
import Data.Int (Int32) import Data.Int (Int32)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
@ -232,69 +222,3 @@ instance Serialize Type.Value where
$ HashMap.fromList $ HashMap.fromList
$ OrderedMap.toList object $ OrderedMap.toList object
serialize _ _ = Nothing 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

View File

@ -1,49 +0,0 @@
{- This Source Code Form is subject to the terms of the Mozilla Public License,
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 CPP #-}
#ifdef WITH_JSON
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Test helpers.
module Test.Hspec.GraphQL {-# DEPRECATED "Use graphql-spice package instead" #-}
( shouldResolve
, shouldResolveTo
) where
import Control.Monad.Catch (MonadCatch)
import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Language.GraphQL.Error
import Test.Hspec.Expectations (Expectation, expectationFailure, shouldBe, shouldNotSatisfy)
-- | Asserts that a query resolves to some value.
shouldResolveTo :: MonadCatch m
=> Either (ResponseEventStream m Aeson.Value) Aeson.Object
-> Aeson.Object
-> Expectation
shouldResolveTo (Right actual) expected = actual `shouldBe` expected
shouldResolveTo _ _ = expectationFailure
"the query is expected to resolve to a value, but it resolved to an event stream"
-- | Asserts that the response doesn't contain any errors.
shouldResolve :: MonadCatch m
=> (Text -> IO (Either (ResponseEventStream m Aeson.Value) Aeson.Object))
-> Text
-> Expectation
shouldResolve executor query = do
actual <- executor query
case actual of
Right response ->
response `shouldNotSatisfy` HashMap.member "errors"
_ -> expectationFailure
"the query is expected to resolve to a value, but it resolved to an event stream"
#else
module Test.Hspec.GraphQL {-# DEPRECATED "Use graphql-spice package instead" #-}
(
) where
#endif