diff --git a/CHANGELOG.md b/CHANGELOG.md index fe0dac5..24e5350 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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`, diff --git a/graphql.cabal b/graphql.cabal index dde2128..417db28 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -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 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 diff --git a/src/Test/Hspec/GraphQL.hs b/src/Test/Hspec/GraphQL.hs deleted file mode 100644 index a848c15..0000000 --- a/src/Test/Hspec/GraphQL.hs +++ /dev/null @@ -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