CHANGELOG.md

@@ -7,18 +7,3 @@ and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
 ## [Unreleased]
-### Added
-- `ToGraphQL` and `FromGraphQL` instances for `Word`.
-
-## [1.0.1.0] - 2023-02-17
-### Added
-- `ToGraphQL` and `FromGraphQL` typeclasses with instances for basic types.
-- `Resolver` module with `argument` and `defaultResolver` helper functions.
-
-## 1.0.0.0 - 2022-03-29
-### Added
-- JSON serialization.
-- Test helpers.
-
-[Unreleased]: https://www.caraus.tech/projects/pub-graphql-spice/repository/28/diff?rev=master&rev_to=v1.0.1.0
-[1.0.1.0]: https://www.caraus.tech/projects/pub-graphql-spice/repository/28/diff?rev=v1.0.1.0&rev_to=v1.0.0.0

cabal.project

@@ -1,4 +1,4 @@
-packages:
+packages: .
-  .
 
 constraints: graphql -json
+tests: False

graphql-spice.cabal

@@ -1,22 +1,22 @@
 cabal-version:      2.4
 
 name:               graphql-spice
-version:            1.0.1.0
+version:            0.1.0.0
 synopsis:           GraphQL with batteries
-description:        Various extensions and convenience functions for the core
+description:        Various extensions and convenience functions  for the core
                     graphql package.
 category:           Language
 homepage:           https://www.caraus.tech/projects/pub-graphql-spice
 bug-reports:        https://www.caraus.tech/projects/pub-graphql-spice/issues
 author:             Eugen Wissner <belka@caraus.de>
 maintainer:         belka@caraus.de
-copyright:          (c) 2021-2023 Eugen Wissner
+copyright:          (c) 2021 Eugen Wissner
 license:            MPL-2.0
 license-files:      LICENSE
 build-type:         Simple
 extra-source-files: CHANGELOG.md
 tested-with:
-  GHC == 9.2.5
+  GHC == 8.10.7
 
 source-repository head
   type: git
@@ -24,35 +24,21 @@ source-repository head
 
 library
     exposed-modules:
-      Language.GraphQL.Class
+      Language.GraphQL.Foundation,
-      Language.GraphQL.JSON
+      Language.GraphQL.Serialize
-      Language.GraphQL.Resolver
-      Test.Hspec.GraphQL
     other-modules:
     hs-source-dirs:   src
     ghc-options: -Wall
     build-depends:
       aeson ^>= 2.0.3,
-      base >= 4.7 && < 5,
+      base ^>=4.14.3.0,
-      conduit ^>= 1.3.4,
+      graphql ^>= 1.0.2
-      containers ^>= 0.6.2,
-      exceptions ^>= 0.10.4,
-      hspec-expectations >= 0.8.2 && < 0.9,
-      graphql >= 1.0,
-      megaparsec >= 9.0 && < 10,
-      scientific ^>= 0.3.7,
-      text >= 1.2 && < 3,
-      transformers ^>= 0.5.6,
-      vector ^>= 0.12.3,
-      unordered-containers ^>= 0.2.16
     default-language: Haskell2010
 
 test-suite graphql-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
-    Language.GraphQL.ClassSpec
-    Language.GraphQL.CoerceSpec
     Language.GraphQL.DirectiveSpec
     Language.GraphQL.FragmentSpec
     Language.GraphQL.RootOperationSpec
@@ -61,11 +47,10 @@ test-suite graphql-test
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
   build-depends:
     aeson,
-    base,
+    base >= 4.8 && < 5,
     graphql,
     graphql-spice,
     hspec >= 2.9.1 && < 3,
-    scientific,
     text,
     unordered-containers
   default-language: Haskell2010

src/Language/GraphQL/Class.hs

@@ -1,136 +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 OverloadedStrings #-}
-
--- | ToGraphQL and FromGraphQL typeclasses used for user-defined type
--- conversion.
-module Language.GraphQL.Class
-    ( FromGraphQL(..)
-    , ToGraphQL(..)
-    ) where
-
-import Data.Foldable (toList)
-import Data.Int (Int8, Int16, Int32, Int64)
-import Data.Text (Text)
-import Data.Word (Word8, Word16, Word32, Word64)
-import qualified Data.Text.Read as Text.Read
-import Data.Vector (Vector)
-import qualified Data.Vector as Vector
-import qualified Language.GraphQL.Type as Type
-
-fromGraphQLToIntegral :: Integral a => Type.Value -> Maybe a
-fromGraphQLToIntegral (Type.Int value) = Just $ fromIntegral value
-fromGraphQLToIntegral (Type.String value) =
-    case Text.Read.decimal value of
-        Right (converted, "") -> Just converted
-        _conversionError -> Nothing
-fromGraphQLToIntegral _ = Nothing
-
--- | Instances of this typeclass can be converted to GraphQL internal
--- representation.
-class ToGraphQL a where
-    toGraphQL :: a -> Type.Value
-
-instance ToGraphQL Text where
-    toGraphQL = Type.String
-
-instance ToGraphQL Int where
-    toGraphQL = Type.Int . fromIntegral
-
-instance ToGraphQL Int8 where
-    toGraphQL = Type.Int . fromIntegral
-
-instance ToGraphQL Int16 where
-    toGraphQL = Type.Int . fromIntegral
-
-instance ToGraphQL Int32 where
-    toGraphQL = Type.Int
-
-instance ToGraphQL Int64 where
-    toGraphQL = Type.Int . fromIntegral
-
-instance ToGraphQL Word where
-    toGraphQL = Type.Int . fromIntegral
-
-instance ToGraphQL Word8 where
-    toGraphQL = Type.Int . fromIntegral
-
-instance ToGraphQL Word16 where
-    toGraphQL = Type.Int . fromIntegral
-
-instance ToGraphQL Word32 where
-    toGraphQL = Type.Int . fromIntegral
-
-instance ToGraphQL Word64 where
-    toGraphQL = Type.Int . fromIntegral
-
-instance ToGraphQL a => ToGraphQL [a] where
-    toGraphQL = Type.List . fmap toGraphQL
-
-instance ToGraphQL a => ToGraphQL (Vector a) where
-    toGraphQL = Type.List . toList . fmap toGraphQL
-
-instance ToGraphQL a => ToGraphQL (Maybe a) where
-    toGraphQL (Just justValue) = toGraphQL justValue
-    toGraphQL Nothing = Type.Null
-
-instance ToGraphQL Bool where
-    toGraphQL = Type.Boolean
-
--- | Instances of this typeclass can be used to convert GraphQL internal
--- representation to user-defined type.
-class FromGraphQL a where
-    fromGraphQL :: Type.Value -> Maybe a
-
-instance FromGraphQL Text where
-    fromGraphQL (Type.String value) = Just value
-    fromGraphQL _ = Nothing
-
-instance FromGraphQL Int where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL Int8 where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL Int16 where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL Int32 where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL Int64 where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL Word where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL Word8 where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL Word16 where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL Word32 where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL Word64 where
-    fromGraphQL = fromGraphQLToIntegral
-
-instance FromGraphQL a => FromGraphQL [a] where
-    fromGraphQL (Type.List value) = traverse fromGraphQL value
-    fromGraphQL _ = Nothing
-
-instance FromGraphQL a => FromGraphQL (Vector a) where
-    fromGraphQL (Type.List value) = Vector.fromList
-        <$> traverse fromGraphQL value
-    fromGraphQL _ = Nothing
-
-instance FromGraphQL a => FromGraphQL (Maybe a) where
-    fromGraphQL Type.Null = Just Nothing
-    fromGraphQL value = Just <$> fromGraphQL value
-
-instance FromGraphQL Bool where
-    fromGraphQL (Type.Boolean value) = Just value
-    fromGraphQL _ = Nothing

src/Language/GraphQL/Foundation.hs

@@ -0,0 +1,5 @@
+module Language.GraphQL.Foundation
+    ( module Language.GraphQL.Serialize
+    ) where
+
+import Language.GraphQL.Serialize

src/Language/GraphQL/JSON.hs

@@ -1,159 +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 OverloadedStrings #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
-
--- | JSON serialization.
-module Language.GraphQL.JSON
-    ( JSON(..)
-    , graphql
-    ) where
-
-import Control.Monad.Catch (MonadCatch)
-import qualified Data.Aeson.Types as Aeson
-import Data.Maybe (catMaybes)
-import qualified Data.Sequence as Seq
-import Data.Vector (Vector)
-import qualified Data.Vector as Vector
-import qualified Language.GraphQL as GraphQL
-import Language.GraphQL.AST (Location(..), Name)
-import Language.GraphQL.Error
-import Language.GraphQL.Type.Schema (Schema)
-import Data.Bifunctor (Bifunctor(..))
-import qualified Conduit
-import qualified Data.Aeson.Key as Aeson.Key
-import qualified Data.Aeson.KeyMap as KeyMap
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
-import Data.Scientific (toBoundedInteger, toRealFloat)
-import Data.Text (Text)
-import Language.GraphQL.Execute.Coerce
-import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
-import qualified Language.GraphQL.Type.In as In
-import qualified Language.GraphQL.Type.Out as Out
-import qualified Language.GraphQL.Type as Type
-
--- | Wraps an aeson value.
-newtype JSON = JSON Aeson.Value
-
-instance Aeson.ToJSON JSON where
-    toJSON (JSON value) = value
-
-instance Aeson.FromJSON JSON where
-    parseJSON = pure . JSON
-
-instance Serialize JSON where
-    serialize (Out.ScalarBaseType scalarType) value
-        | Type.ScalarType "Int" _ <- scalarType
-        , Int int <- value = Just $ JSON $ Aeson.Number $ fromIntegral int
-        | Type.ScalarType "Float" _ <- scalarType
-        , Float float <- value = Just $ JSON $ Aeson.toJSON float
-        | Type.ScalarType "String" _ <- scalarType
-        , String string <- value = Just $ JSON $ Aeson.String string
-        | Type.ScalarType "ID" _ <- scalarType
-        , String string <- value = Just $ JSON $ Aeson.String string
-        | Type.ScalarType "Boolean" _ <- scalarType
-        , Boolean boolean <- value = Just $ JSON $ Aeson.Bool boolean
-    serialize _ (Enum enum) = Just $ JSON $ Aeson.String enum
-    serialize _ (List list) = Just $ JSON $ Aeson.toJSON list
-    serialize _ (Object object) = Just
-        $ JSON
-        $ Aeson.object
-        $ toJSONKeyValue <$> OrderedMap.toList object
-      where
-        toJSONKeyValue (key, value) = (Aeson.Key.fromText key, Aeson.toJSON value)
-    serialize _ _ = Nothing
-    null = JSON Aeson.Null
-
-instance VariableValue JSON where
-    coerceVariableValue _ (JSON Aeson.Null) = Just Type.Null
-    coerceVariableValue (In.ScalarBaseType scalarType) (JSON 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 _) (JSON (Aeson.String stringValue)) =
-        Just $ Type.Enum stringValue
-    coerceVariableValue (In.InputObjectBaseType objectType) (JSON value)
-        | (Aeson.Object objectValue) <- value = do
-            let (In.InputObjectType _ _ inputFields) = objectType
-            (newObjectValue, resultMap) <- foldWithKey objectValue inputFields
-            if KeyMap.null newObjectValue
-                then Just $ Type.Object resultMap
-                else Nothing
-      where
-        foldWithKey :: Aeson.Object
-            -> HashMap Name In.InputField
-            -> Maybe (Aeson.Object, HashMap Name Type.Value)
-        foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues'
-            $ Just (objectValue, HashMap.empty)
-        matchFieldValues' :: Text
-            -> In.InputField
-            -> Maybe (Aeson.Object, HashMap Name Type.Value)
-            -> Maybe (Aeson.Object, HashMap Name Type.Value)
-        matchFieldValues' _ _ Nothing = Nothing
-        matchFieldValues' fieldName inputField (Just (objectValue, resultMap)) =
-            let fieldKey = Aeson.Key.fromText fieldName
-                In.InputField _ fieldType _ = inputField
-                insert = flip (HashMap.insert fieldName) resultMap
-                newObjectValue = KeyMap.delete fieldKey objectValue
-             in case KeyMap.lookup fieldKey objectValue of
-                    Just variableValue -> do
-                        coerced <- coerceVariableValue fieldType
-                            $ JSON variableValue
-                        pure (newObjectValue, insert coerced)
-                    Nothing -> Just (objectValue, resultMap)
-    coerceVariableValue (In.ListBaseType listType) (JSON value)
-        | (Aeson.Array arrayValue) <- value =
-            Type.List <$> foldr foldVector (Just []) arrayValue
-        | otherwise = coerceVariableValue listType $ JSON value
-      where
-        foldVector _ Nothing = Nothing
-        foldVector variableValue (Just list) = do
-            coerced <- coerceVariableValue listType $ JSON variableValue
-            pure $ coerced : list
-    coerceVariableValue _ _ = Nothing
-
--- | If the text parses correctly as a @GraphQL@ query the query is
--- executed using the given 'Schema'.
-graphql :: MonadCatch m
-    => Schema m -- ^ Resolvers.
-    -> Maybe Text -- ^ Operation name.
-    -> Aeson.Object -- ^ Variables.
-    -> Text -- ^ Text representing a @GraphQL@ request document.
-    -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
-graphql schema operationName variableValues = fmap (bimap stream formatResponse)
-    . GraphQL.graphql schema operationName jsonVariables
-  where
-    jsonVariables = JSON <$> KeyMap.toHashMapText variableValues
-    -- stream :: ResponseEventStream m JSON -> ResponseEventStream m Aeson.Value
-    stream = Conduit.mapOutput mapResponse
-    mapResponse response@Response{ data' = JSON json } =
-        response{ data' = json }
-    formatResponse :: Response JSON -> Aeson.Object
-    formatResponse Response{ errors, data' = JSON json } =
-        let dataResponse = KeyMap.singleton "data" json
-         in case errors of
-              Seq.Empty -> dataResponse
-              _ -> flip (KeyMap.insert "errors") dataResponse
-                  $ Aeson.Array $ foldr fromError mempty errors
-    fromError :: Error -> Vector Aeson.Value -> Vector Aeson.Value
-    fromError Error{..} = Vector.cons $ Aeson.object $ catMaybes
-        [ Just ("message", Aeson.String message)
-        , toMaybe fromLocation "locations" locations
-        , toMaybe fromPath "path" path
-        ]
-    fromPath (Segment segment) = Aeson.String segment
-    fromPath (Index index) = Aeson.toJSON index
-    fromLocation Location{..} = Aeson.object
-        [ ("line", Aeson.toJSON line)
-        , ("column", Aeson.toJSON column)
-        ]
-    toMaybe _ _ [] = Nothing
-    toMaybe f key xs = Just (key, Aeson.listValue f xs)

src/Language/GraphQL/Resolver.hs

@@ -1,61 +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 OverloadedStrings #-}
-
--- | Helper functions and exceptions to write resolvers.
-module Language.GraphQL.Resolver
-    ( argument
-    , defaultResolver
-    ) where
-
-import Control.Monad.Catch (Exception(..), MonadCatch(..), MonadThrow(..))
-import Control.Monad.Trans.Reader (ReaderT, asks)
-import Data.HashMap.Strict ((!))
-import Data.Text (Text)
-import qualified Data.Text as Text
-import Data.Typeable (cast)
-import Language.GraphQL.AST.Document (Name)
-import Language.GraphQL.Error
-import qualified Language.GraphQL.Type as Type
-import Language.GraphQL.Class (FromGraphQL(..))
-
--- | Exceptions thrown by the functions in this module.
-data ServerException
-    = FieldNotResolvedException !Text
-    | ErroneousArgumentTypeException !Text
-
-instance Show ServerException where
-    show (FieldNotResolvedException fieldName) =
-        Text.unpack $ Text.unwords ["Field", fieldName, "not resolved."]
-    show (ErroneousArgumentTypeException argumentName) =
-        Text.unpack $ Text.unwords
-            [ "Unable to convert the argument"
-            , argumentName
-            , "to a user-defined type."
-            ]
-
-instance Exception ServerException where
-    toException = toException . ResolverException
-    fromException x = do
-        ResolverException a <- fromException x
-        cast a
-
--- | Default resolver expects that the field value is returned by the parent
--- object. If the parent is not an object or it doesn't contain the requested
--- field name, an error is thrown.
-defaultResolver :: MonadCatch m => Name -> Type.Resolve m
-defaultResolver fieldName = do
-    values' <- asks Type.values
-    case values' of
-        Type.Object objectValue -> pure $ objectValue ! fieldName
-        _nonObject -> throwM $ FieldNotResolvedException fieldName
-
--- | Takes an argument name, validates that the argument exists, and optionally
--- converts it to a user-defined type.
-argument :: (MonadCatch m, FromGraphQL a) => Name -> ReaderT Type.Context m a
-argument argumentName =
-    Type.argument argumentName >>= maybe throwError pure . fromGraphQL
-  where
-    throwError = throwM $ ErroneousArgumentTypeException argumentName

src/Language/GraphQL/Serialize.hs

@@ -0,0 +1,7 @@
+module Language.GraphQL.Serialize
+    ( JSON(..)
+    ) where
+
+import qualified Data.Aeson as Aeson
+
+newtype JSON = JSON Aeson.Value

src/Test/Hspec/GraphQL.hs

@@ -1,48 +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 ExplicitForAll #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-
--- | Test helpers.
-module Test.Hspec.GraphQL
-    ( shouldResolve
-    , shouldResolveTo
-    ) where
-
-import Control.Monad.Catch (MonadCatch)
-import qualified Data.Sequence as Seq
-import Data.Text (Text)
-import Language.GraphQL.Error
-import Language.GraphQL.Execute
-import Test.Hspec.Expectations
-    ( Expectation
-    , expectationFailure
-    , shouldBe
-    , shouldSatisfy
-    )
-
--- | Asserts that a query resolves to some value.
-shouldResolveTo :: (MonadCatch m, Serialize b, Eq b, Show b)
-    => Either (ResponseEventStream m b) (Response b)
-    -> b
-    -> Expectation
-shouldResolveTo (Right Response{ errors = Seq.Empty, data' }) expected =
-    data' `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, Serialize b)
-    => (Text -> IO (Either (ResponseEventStream m b) (Response b)))
-    -> Text
-    -> Expectation
-shouldResolve executor query = do
-    actual <- executor query
-    case actual of
-        Right Response{ errors } -> errors `shouldSatisfy` Seq.null
-        _ -> expectationFailure
-            "the query is expected to resolve to a value, but it resolved to an event stream"

tests/Language/GraphQL/ClassSpec.hs

@@ -1,47 +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 OverloadedStrings #-}
-module Language.GraphQL.ClassSpec
-    ( spec
-    ) where
-
-import Data.Text (Text)
-import qualified Language.GraphQL.Type as Type
-import Language.GraphQL.Class (FromGraphQL(..), ToGraphQL(..))
-import Test.Hspec (Spec, describe, it, shouldBe)
-
-spec :: Spec
-spec = do
-    describe "ToGraphQL" $ do
-        it "converts integers" $
-            toGraphQL (5 :: Int) `shouldBe` Type.Int 5
-
-        it "converts text" $
-            toGraphQL ("String" :: Text) `shouldBe` Type.String "String"
-
-        it "converts booleans" $
-            toGraphQL True `shouldBe` Type.Boolean True
-
-        it "converts Nothing to Null" $
-            toGraphQL (Nothing :: Maybe Int) `shouldBe` Type.Null
-
-        it "converts singleton lists" $
-            toGraphQL [True] `shouldBe` Type.List [Type.Boolean True]
-
-    describe "FromGraphQL" $ do
-        it "converts integers" $
-            fromGraphQL (Type.Int 5) `shouldBe` Just (5 :: Int)
-
-        it "converts text" $
-            fromGraphQL (Type.String "String") `shouldBe` Just ("String" :: Text)
-
-        it "converts booleans" $
-            fromGraphQL (Type.Boolean True) `shouldBe` Just True
-
-        it "converts Null to Nothing" $
-            fromGraphQL Type.Null `shouldBe` Just (Nothing :: Maybe Int)
-
-        it "converts singleton lists" $
-            fromGraphQL (Type.List [Type.Boolean True]) `shouldBe` Just [True]

tests/Language/GraphQL/CoerceSpec.hs

@@ -1,98 +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 OverloadedStrings #-}
-module Language.GraphQL.CoerceSpec
-    ( spec
-    ) where
-
-import Data.Aeson as Aeson ((.=))
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Types as Aeson
-import qualified Data.HashMap.Strict as HashMap
-import Data.Maybe (isNothing)
-import Data.Scientific (scientific)
-import qualified Language.GraphQL.Execute.Coerce as Coerce
-import Language.GraphQL.JSON (JSON(..))
-import qualified Language.GraphQL.Type.In as In
-import Language.GraphQL.Type
-import Prelude hiding (id)
-import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
-
-singletonInputObject :: In.Type
-singletonInputObject = In.NamedInputObjectType type'
-  where
-    type' = In.InputObjectType "ObjectName" Nothing inputFields
-    inputFields = HashMap.singleton "field" field
-    field = In.InputField Nothing (In.NamedScalarType string) Nothing
-
-namedIdType :: In.Type
-namedIdType = In.NamedScalarType id
-
-spec :: Spec
-spec =
-    describe "VariableValue Aeson" $ do
-        it "coerces strings" $
-            let expected = Just (String "asdf")
-                actual = Coerce.coerceVariableValue (In.NamedScalarType string)
-                    $ JSON $ Aeson.String "asdf"
-             in actual `shouldBe` expected
-        it "coerces non-null strings" $
-            let expected = Just (String "asdf")
-                actual = Coerce.coerceVariableValue (In.NonNullScalarType string)
-                    $ JSON $ Aeson.String "asdf"
-             in actual `shouldBe` expected
-        it "coerces booleans" $
-            let expected = Just (Boolean True)
-                actual = Coerce.coerceVariableValue (In.NamedScalarType boolean)
-                    $ JSON $ Aeson.Bool True
-             in actual `shouldBe` expected
-        it "coerces zero to an integer" $
-            let expected = Just (Int 0)
-                actual = Coerce.coerceVariableValue (In.NamedScalarType int)
-                    $ JSON $ Aeson.Number 0
-             in actual `shouldBe` expected
-        it "rejects fractional if an integer is expected" $
-            let actual = Coerce.coerceVariableValue (In.NamedScalarType int)
-                    $ JSON $ Aeson.Number $ scientific 14 (-1)
-             in actual `shouldSatisfy` isNothing
-        it "coerces float numbers" $
-            let expected = Just (Float 1.4)
-                actual = Coerce.coerceVariableValue (In.NamedScalarType float)
-                    $ JSON $ Aeson.Number $ scientific 14 (-1)
-             in actual `shouldBe` expected
-        it "coerces IDs" $
-            let expected = Just (String "1234")
-                json = JSON $ Aeson.String "1234"
-                actual = Coerce.coerceVariableValue namedIdType json
-             in actual `shouldBe` expected
-        it "coerces input objects" $
-            let actual = Coerce.coerceVariableValue singletonInputObject
-                    $ JSON
-                    $ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]
-                expected = Just $ Object $ HashMap.singleton "field" "asdf"
-             in actual `shouldBe` expected
-        it "skips the field if it is missing in the variables" $
-            let actual = Coerce.coerceVariableValue singletonInputObject
-                    $ JSON Aeson.emptyObject
-                expected = Just $ Object HashMap.empty
-             in actual `shouldBe` expected
-        it "fails if input object value contains extra fields" $
-            let actual = Coerce.coerceVariableValue singletonInputObject
-                    $ JSON $ Aeson.object variableFields
-                variableFields =
-                    [ "field" .= ("asdf" :: Aeson.Value)
-                    , "extra" .= ("qwer" :: Aeson.Value)
-                    ]
-             in actual `shouldSatisfy` isNothing
-        it "preserves null" $
-            let actual = Coerce.coerceVariableValue namedIdType
-                    $ JSON Aeson.Null
-             in actual `shouldBe` Just Null
-        it "preserves list order" $
-            let list = JSON $ Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
-                listType = (In.ListType $ In.NamedScalarType string)
-                actual = Coerce.coerceVariableValue listType list
-                expected = Just $ List [String "asdf", String "qwer"]
-             in actual `shouldBe` expected

tests/Language/GraphQL/DirectiveSpec.hs

@@ -4,21 +4,19 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE PackageImports #-}
-
 module Language.GraphQL.DirectiveSpec
     ( spec
     ) where
 
-import Language.GraphQL.AST.Document (Name)
+import Data.Aeson (object, (.=))
-import Data.HashMap.Strict (HashMap)
+import qualified Data.Aeson as Aeson
 import qualified Data.HashMap.Strict as HashMap
-import qualified Language.GraphQL as GraphQL
+import Language.GraphQL.Foundation
 import Language.GraphQL.TH
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.Out as Out
 import Test.Hspec (Spec, describe, it)
-import "graphql-spice" Test.Hspec.GraphQL
+import Test.Hspec.GraphQL
 
 experimentalResolver :: Schema IO
 experimentalResolver = schema queryType Nothing Nothing mempty
@@ -28,6 +26,9 @@ experimentalResolver = schema queryType Nothing Nothing mempty
         $ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
         $ pure $ Int 5
 
+emptyObject :: Aeson.Object
+emptyObject = HashMap.singleton "data" $ object []
+
 spec :: Spec
 spec =
     describe "Directive executor" $ do
@@ -38,8 +39,8 @@ spec =
               }
             |]
 
-            actual <- GraphQL.graphql experimentalResolver Nothing (mempty :: HashMap Name Value) sourceQuery
+            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldResolveTo` Object mempty
+            actual `shouldResolveTo` emptyObject
 
         it "should not skip fields if @skip is false" $ do
             let sourceQuery = [gql|
@@ -47,8 +48,11 @@ spec =
                 experimentalField @skip(if: false)
               }
             |]
-                expected = Object $ HashMap.singleton "experimentalField" (Int 5)
+                expected = HashMap.singleton "data"
-            actual <- GraphQL.graphql experimentalResolver Nothing (mempty :: HashMap Name Value) sourceQuery
+                    $ object
+                        [ "experimentalField" .= (5 :: Int)
+                        ]
+            actual <- graphql experimentalResolver sourceQuery
             actual `shouldResolveTo` expected
 
         it "should skip fields if @include is false" $ do
@@ -58,8 +62,8 @@ spec =
               }
             |]
 
-            actual <- GraphQL.graphql experimentalResolver Nothing (mempty :: HashMap Name Value) sourceQuery
+            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldResolveTo` Object mempty
+            actual `shouldResolveTo` emptyObject
 
         it "should be able to @skip a fragment spread" $ do
             let sourceQuery = [gql|
@@ -72,8 +76,8 @@ spec =
               }
             |]
 
-            actual <- GraphQL.graphql experimentalResolver Nothing (mempty :: HashMap Name Value) sourceQuery
+            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldResolveTo` Object mempty
+            actual `shouldResolveTo` emptyObject
 
         it "should be able to @skip an inline fragment" $ do
             let sourceQuery = [gql|
@@ -84,5 +88,5 @@ spec =
               }
             |]
 
-            actual <- GraphQL.graphql experimentalResolver Nothing (mempty :: HashMap Name Value) sourceQuery
+            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldResolveTo` Object mempty
+            actual `shouldResolveTo` emptyObject

tests/Language/GraphQL/FragmentSpec.hs

@@ -4,23 +4,20 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE PackageImports #-}
-
 module Language.GraphQL.FragmentSpec
     ( spec
     ) where
 
+import Data.Aeson ((.=))
+import qualified Data.Aeson as Aeson
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
-import Language.GraphQL.AST (Name)
+import Language.GraphQL.Foundation
-import Data.HashMap.Strict (HashMap)
 import Language.GraphQL.Type
-import Language.GraphQL.Error
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.TH
-import qualified Language.GraphQL as GraphQL
 import Test.Hspec (Spec, describe, it)
-import "graphql-spice" Test.Hspec.GraphQL
+import Test.Hspec.GraphQL
 
 size :: (Text, Value)
 size = ("size", String "L")
@@ -91,23 +88,23 @@ spec :: Spec
 spec = do
     describe "Inline fragment executor" $ do
         it "chooses the first selection if the type matches" $ do
-            let localSchema = toSchema "Hat" $ garment "Hat"
+            actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery
-            actual <- GraphQL.graphql localSchema Nothing (mempty :: HashMap Name Value) inlineQuery
+            let expected = HashMap.singleton "data"
-            let expected = Object
+                    $ Aeson.object
-                    $ HashMap.singleton "garment"
+                        [ "garment" .= Aeson.object
-                    $ Object
+                            [ "circumference" .= (60 :: Int)
-                    $ HashMap.singleton  "circumference"
+                            ]
-                    $ Int 60
+                        ]
              in actual `shouldResolveTo` expected
 
         it "chooses the last selection if the type matches" $ do
-            let localSchema = toSchema "Shirt" $ garment "Shirt"
+            actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
-            actual <- GraphQL.graphql localSchema Nothing (mempty :: HashMap Name Value) inlineQuery
+            let expected = HashMap.singleton "data"
-            let expected = Object
+                    $ Aeson.object
-                    $ HashMap.singleton "garment"
+                        [ "garment" .= Aeson.object
-                    $ Object
+                            [ "size" .= ("L" :: Text)
-                    $ HashMap.singleton "size"
+                            ]
-                    $ String "L"
+                        ]
              in actual `shouldResolveTo` expected
 
         it "embeds inline fragments without type" $ do
@@ -119,12 +116,12 @@ spec = do
                 }
               }
             |]
-            let localSchema = toSchema "circumference" circumference
+            actual <- graphql (toSchema "circumference" circumference) sourceQuery
-            actual <- GraphQL.graphql localSchema Nothing (mempty :: HashMap Name Value) sourceQuery
+            let expected = HashMap.singleton "data"
-            let expected = Object $ HashMap.fromList
+                    $ Aeson.object
-                    [ ("circumference", Int 60)
+                        [ "circumference" .= (60 :: Int)
-                    , ("size", String  "L")
+                        , "size" .= ("L" :: Text)
-                    ]
+                        ]
              in actual `shouldResolveTo` expected
 
         it "evaluates fragments on Query" $ do
@@ -135,10 +132,7 @@ spec = do
                 }
               }
             |]
-                localSchema = toSchema "size" size
+             in graphql (toSchema "size" size) `shouldResolve` sourceQuery
-                actual :: Text -> IO (Either (ResponseEventStream IO Value) (Response Value))
-                actual = GraphQL.graphql localSchema Nothing (mempty :: HashMap Name Value)
-             in actual `shouldResolve` sourceQuery
 
     describe "Fragment spread executor" $ do
         it "evaluates fragment spreads" $ do
@@ -151,11 +145,12 @@ spec = do
                 circumference
               }
             |]
-            let localSchema = toSchema "circumference" circumference
+
-            actual <- GraphQL.graphql localSchema Nothing (mempty :: HashMap Name Value) sourceQuery
+            actual <- graphql (toSchema "circumference" circumference) sourceQuery
-            let expected = Object
+            let expected = HashMap.singleton "data"
-                    $ HashMap.singleton "circumference"
+                    $ Aeson.object
-                    $ Int 60
+                        [ "circumference" .= (60 :: Int)
+                        ]
              in actual `shouldResolveTo` expected
 
         it "evaluates nested fragments" $ do
@@ -174,13 +169,14 @@ spec = do
                 circumference
               }
             |]
-            let localSchema = toSchema "Hat" $ garment "Hat"
+
-            actual <- GraphQL.graphql localSchema Nothing (mempty :: HashMap Name Value) sourceQuery
+            actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
-            let expected = Object
+            let expected = HashMap.singleton "data"
-                    $ HashMap.singleton "garment"
+                    $ Aeson.object
-                    $ Object
+                        [ "garment" .= Aeson.object
-                    $ HashMap.singleton "circumference"
+                            [ "circumference" .= (60 :: Int)
-                    $ Int 60
+                            ]
+                        ]
              in actual `shouldResolveTo` expected
 
         it "considers type condition" $ do
@@ -198,11 +194,11 @@ spec = do
                 size
               }
             |]
-                expected = Object
+                expected = HashMap.singleton "data"
-                    $ HashMap.singleton "garment"
+                    $ Aeson.object
-                    $ Object
+                        [ "garment" .= Aeson.object
-                    $ HashMap.singleton "circumference"
+                            [ "circumference" .= (60 :: Int)
-                    $ Int 60
+                            ]
-            let localSchema = toSchema "Hat" $ garment "Hat"
+                        ]
-            actual <- GraphQL.graphql localSchema Nothing (mempty :: HashMap Name Value) sourceQuery
+            actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
             actual `shouldResolveTo` expected

tests/Language/GraphQL/RootOperationSpec.hs

@@ -4,21 +4,18 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE PackageImports #-}
-
 module Language.GraphQL.RootOperationSpec
     ( spec
     ) where
 
-import Data.HashMap.Strict (HashMap)
+import Data.Aeson ((.=), object)
 import qualified Data.HashMap.Strict as HashMap
-import Language.GraphQL
+import Language.GraphQL.Foundation
-import Language.GraphQL.AST (Name)
 import Test.Hspec (Spec, describe, it)
 import Language.GraphQL.TH
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.Out as Out
-import "graphql-spice" Test.Hspec.GraphQL
+import Test.Hspec.GraphQL
 
 hatType :: Out.ObjectType IO
 hatType = Out.ObjectType "Hat" Nothing []
@@ -52,12 +49,13 @@ spec =
                 }
               }
             |]
-                expected = Object
+                expected = HashMap.singleton "data"
-                    $ HashMap.singleton "garment"
+                    $ object
-                    $ Object
+                        [ "garment" .= object
-                    $ HashMap.singleton "circumference"
+                            [ "circumference" .= (60 :: Int)
-                    $ Int 60
+                            ]
-            actual <- graphql garmentSchema Nothing (mempty :: HashMap Name Value) querySource
+                        ]
+            actual <- graphql garmentSchema querySource
             actual `shouldResolveTo` expected
 
         it "chooses Mutation" $ do
@@ -66,8 +64,9 @@ spec =
                 incrementCircumference
               }
             |]
-                expected = Object
+                expected = HashMap.singleton "data"
-                    $ HashMap.singleton "incrementCircumference"
+                    $ object
-                    $ Int 61
+                        [ "incrementCircumference" .= (61 :: Int)
-            actual <- graphql garmentSchema Nothing (mempty :: HashMap Name Value) querySource
+                        ]
+            actual <- graphql garmentSchema querySource
             actual `shouldResolveTo` expected