Remove JSON support in the core package
This commit is contained in:
parent
83f2dc1a2d
commit
2834360411
GPG Key ID:
A27FDC1E8EE902C0
|
|
@ -10,10 +10,17 @@ and this project adheres to
|
|||
### Added
|
||||
- Schema printing.
|
||||
- `Semigroup` and `Monoid` instances for `AST.Document.Description`.
|
||||
- Support for vector 0.13.0.0 and transformers 0.6.1.0.
|
||||
|
||||
### Fixed
|
||||
- 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
|
||||
### Changed
|
||||
- Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`,
|
||||
|
|
|
|||
|
|
@ -21,18 +21,12 @@ extra-source-files:
|
|||
CHANGELOG.md
|
||||
README.md
|
||||
tested-with:
|
||||
GHC == 8.10.7,
|
||||
GHC == 9.2.4
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: git://caraus.tech/pub/graphql.git
|
||||
|
||||
flag Json
|
||||
description: Whether to build against @aeson 1.x@
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
Language.GraphQL
|
||||
|
|
@ -53,7 +47,6 @@ library
|
|||
Language.GraphQL.Type.Schema
|
||||
Language.GraphQL.Validate
|
||||
Language.GraphQL.Validate.Validation
|
||||
Test.Hspec.GraphQL
|
||||
other-modules:
|
||||
Language.GraphQL.Execute.Transform
|
||||
Language.GraphQL.Type.Definition
|
||||
|
|
@ -72,15 +65,9 @@ library
|
|||
parser-combinators >= 1.3 && < 2,
|
||||
template-haskell >= 2.16 && < 3,
|
||||
text >= 1.2 && < 3,
|
||||
transformers ^>= 0.5.6,
|
||||
transformers >= 0.5.6 && < 0.7,
|
||||
unordered-containers ^>= 0.2.14,
|
||||
vector ^>= 0.12.3
|
||||
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
|
||||
vector >= 0.12 && < 0.14
|
||||
|
||||
default-language: Haskell2010
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in New Issue