Release 1.0.2.0

- `Serialize` instance for `Type.Definition.Value`.
- `VariableValue` instance for `Type.Definition.Value`.

It makes it possible to use the library without an additional
serialization format like JSON.

CHANGELOG.md

@@ -6,6 +6,13 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
+## [1.0.2.0] - 2021-12-26
+### Added
+- `Serialize` instance for `Type.Definition.Value`.
+- `VariableValue` instance for `Type.Definition.Value`.
+- `Json` build flag, enabled by default. JSON and Aeson support can be disabled
+  by disabling this flag.
+
 ## [1.0.1.0] - 2021-09-27
 ### Added
 - Custom `Show` instance for `Type.Definition.Value` (for error
@@ -459,6 +466,7 @@ and this project adheres to
 ### Added
 - Data types for the GraphQL language.
 
+[1.0.2.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=1.0.2.0&rev_to=v1.0.1.0
 [1.0.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.1.0&rev_to=v1.0.0.0
 [1.0.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.0.0&rev_to=v0.11.1.0
 [0.11.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.11.1.0&rev_to=v0.11.0.0

graphql.cabal

@@ -1,7 +1,7 @@
-cabal-version: 2.2
+cabal-version: 2.4
 
 name:           graphql
-version:        1.0.1.0
+version:        1.0.2.0
 synopsis:       Haskell GraphQL implementation
 description:    Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
 category:       Language
@@ -18,93 +18,100 @@ license-files:  LICENSE,
                 LICENSE.MPL
 build-type:     Simple
 extra-source-files:
-    CHANGELOG.md
-    README.md
+  CHANGELOG.md
+  README.md
 tested-with:
-    GHC == 8.10.7
-  , GHC == 9.0.1
+  GHC == 8.10.7,
+  GHC == 9.0.1,
+  GHC == 9.2.1
 
 source-repository head
   type: git
   location: git://caraus.tech/pub/graphql.git
 
+flag Json
+  description: Whether to build against @aeson 1.x@
+  default: True
+  manual: True
+
 library
   exposed-modules:
-      Language.GraphQL
-      Language.GraphQL.AST
-      Language.GraphQL.AST.DirectiveLocation
-      Language.GraphQL.AST.Document
-      Language.GraphQL.AST.Encoder
-      Language.GraphQL.AST.Lexer
-      Language.GraphQL.AST.Parser
-      Language.GraphQL.Error
-      Language.GraphQL.Execute
-      Language.GraphQL.Execute.Coerce
-      Language.GraphQL.Execute.OrderedMap
-      Language.GraphQL.TH
-      Language.GraphQL.Type
-      Language.GraphQL.Type.In
-      Language.GraphQL.Type.Out
-      Language.GraphQL.Type.Schema
-      Language.GraphQL.Validate
-      Language.GraphQL.Validate.Validation
-      Test.Hspec.GraphQL
+    Language.GraphQL
+    Language.GraphQL.AST
+    Language.GraphQL.AST.DirectiveLocation
+    Language.GraphQL.AST.Document
+    Language.GraphQL.AST.Encoder
+    Language.GraphQL.AST.Lexer
+    Language.GraphQL.AST.Parser
+    Language.GraphQL.Error
+    Language.GraphQL.Execute
+    Language.GraphQL.Execute.Coerce
+    Language.GraphQL.Execute.OrderedMap
+    Language.GraphQL.TH
+    Language.GraphQL.Type
+    Language.GraphQL.Type.In
+    Language.GraphQL.Type.Out
+    Language.GraphQL.Type.Schema
+    Language.GraphQL.Validate
+    Language.GraphQL.Validate.Validation
+    Test.Hspec.GraphQL
   other-modules:
-      Language.GraphQL.Execute.Transform
-      Language.GraphQL.Type.Definition
-      Language.GraphQL.Type.Internal
-      Language.GraphQL.Validate.Rules
+    Language.GraphQL.Execute.Transform
+    Language.GraphQL.Type.Definition
+    Language.GraphQL.Type.Internal
+    Language.GraphQL.Validate.Rules
   hs-source-dirs:
-      src
+    src
   ghc-options: -Wall
+
   build-depends:
-      aeson >= 1.5.6 && < 1.6
-    , base >= 4.7 && < 5
-    , conduit >= 1.3.4 && < 1.4
-    , containers >= 0.6.2 && < 0.7
-    , exceptions >= 0.10.4 && < 0.11
-    , hspec-expectations >= 0.8.2 && < 0.9
-    , megaparsec >= 9.0.1 && < 9.1
-    , parser-combinators >= 1.3.0 && < 1.4
-    , scientific >= 0.3.7 && < 0.4
-    , template-haskell >= 2.16 && < 2.18
-    , text >= 1.2.4 && < 1.3
-    , transformers >= 0.5.6 && < 0.6
-    , unordered-containers >= 0.2.14 && < 0.3
-    , vector >= 0.12.3 && < 0.13
+    base >= 4.7 && < 5,
+    conduit ^>= 1.3.4,
+    containers ^>= 0.6.2,
+    exceptions ^>= 0.10.4,
+    megaparsec >= 9.0 && < 10,
+    parser-combinators >= 1.3 && < 2,
+    template-haskell >= 2.16 && < 3,
+    text ^>= 1.2.4,
+    transformers ^>= 0.5.6,
+    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
+
   default-language: Haskell2010
 
 test-suite graphql-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
-      Language.GraphQL.AST.DocumentSpec
-      Language.GraphQL.AST.EncoderSpec
-      Language.GraphQL.AST.LexerSpec
-      Language.GraphQL.AST.ParserSpec
-      Language.GraphQL.ErrorSpec
-      Language.GraphQL.Execute.CoerceSpec
-      Language.GraphQL.Execute.OrderedMapSpec
-      Language.GraphQL.ExecuteSpec
-      Language.GraphQL.Type.OutSpec
-      Language.GraphQL.Validate.RulesSpec
-      Test.DirectiveSpec
-      Test.FragmentSpec
-      Test.RootOperationSpec
+    Language.GraphQL.AST.DocumentSpec
+    Language.GraphQL.AST.EncoderSpec
+    Language.GraphQL.AST.LexerSpec
+    Language.GraphQL.AST.ParserSpec
+    Language.GraphQL.ErrorSpec
+    Language.GraphQL.Execute.CoerceSpec
+    Language.GraphQL.Execute.OrderedMapSpec
+    Language.GraphQL.ExecuteSpec
+    Language.GraphQL.Type.OutSpec
+    Language.GraphQL.Validate.RulesSpec
   hs-source-dirs:
-      tests
+    tests
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
+
   build-depends:
-      QuickCheck >= 2.14.1 && < 2.15
-    , aeson
-    , base >= 4.8 && < 5
-    , conduit
-    , exceptions
-    , graphql
-    , hspec >= 2.8.2 && < 2.9
-    , hspec-megaparsec >= 2.2.0 && < 2.3
-    , megaparsec
-    , scientific
-    , text
-    , unordered-containers
+    QuickCheck ^>= 2.14.1,
+    base,
+    conduit,
+    exceptions,
+    graphql,
+    hspec ^>= 2.9.1,
+    hspec-megaparsec ^>= 2.2.0,
+    megaparsec,
+    text,
+    unordered-containers
   default-language: Haskell2010

src/Language/GraphQL.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE CPP #-}
+
+#ifdef WITH_JSON
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -73,3 +76,9 @@ graphqlSubs schema operationName variableValues document' =
         [ ("line", Aeson.toJSON line)
         , ("column", Aeson.toJSON column)
         ]
+#else
+-- | This module provides the functions to parse and execute @GraphQL@ queries.
+module Language.GraphQL
+    (
+    ) where
+#endif

src/Language/GraphQL/Execute/Coerce.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE CPP #-}
 
 -- | Types and functions used for input and result coercion.
 module Language.GraphQL.Execute.Coerce
@@ -15,7 +16,10 @@ 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
@@ -24,7 +28,6 @@ import Data.Text (Text)
 import qualified Data.Text.Lazy as Text.Lazy
 import qualified Data.Text.Lazy.Builder as Text.Builder
 import qualified Data.Text.Lazy.Builder.Int as Text.Builder
-import Data.Scientific (toBoundedInteger, toRealFloat)
 import Language.GraphQL.AST (Name)
 import Language.GraphQL.Execute.OrderedMap (OrderedMap)
 import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
@@ -61,20 +64,13 @@ class VariableValue a where
         -> a -- ^ Variable value being coerced.
         -> Maybe Type.Value -- ^ Coerced value on success, 'Nothing' otherwise.
 
-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) =
+instance VariableValue Type.Value where
+    coerceVariableValue _ Type.Null = Just Type.Null
+    coerceVariableValue (In.ScalarBaseType _) value = Just value
+    coerceVariableValue (In.EnumBaseType _) (Type.Enum stringValue) =
         Just $ Type.Enum stringValue
     coerceVariableValue (In.InputObjectBaseType objectType) value
-        | (Aeson.Object objectValue) <- value = do
+        | (Type.Object objectValue) <- value = do
             let (In.InputObjectType _ _ inputFields) = objectType
             (newObjectValue, resultMap) <- foldWithKey objectValue inputFields
             if HashMap.null newObjectValue
@@ -94,14 +90,9 @@ instance VariableValue Aeson.Value where
                         pure (newObjectValue, insert coerced)
                     Nothing -> Just (objectValue, resultMap)
     coerceVariableValue (In.ListBaseType listType) value
-        | (Aeson.Array arrayValue) <- value =
-            Type.List <$> foldr foldVector (Just []) arrayValue
+        | (Type.List arrayValue) <- value =
+            Type.List <$> traverse (coerceVariableValue listType) arrayValue
         | otherwise = coerceVariableValue listType value
-      where
-        foldVector _ Nothing = Nothing
-        foldVector variableValue (Just list) = do
-            coerced <- coerceVariableValue listType variableValue
-            pure $ coerced : list 
     coerceVariableValue _ _ = Nothing
 
 -- | Looks up a value by name in the given map, coerces it and inserts into the
@@ -216,6 +207,28 @@ data Output a
 instance forall a. IsString (Output a) where
     fromString = String . fromString
 
+instance Serialize Type.Value where
+    null = Type.Null
+    serialize (Out.ScalarBaseType scalarType) value
+        | Type.ScalarType "Int" _ <- scalarType
+        , Int int <- value = Just $ Type.Int int
+        | Type.ScalarType "Float" _ <- scalarType
+        , Float float <- value = Just $ Type.Float float
+        | Type.ScalarType "String" _ <- scalarType
+        , String string <- value = Just $ Type.String string
+        | Type.ScalarType "ID" _ <- scalarType
+        , String string <- value = Just $ Type.String string
+        | Type.ScalarType "Boolean" _ <- scalarType
+        , Boolean boolean <- value = Just $ Type.Boolean boolean
+    serialize _ (Enum enum) = Just $ Type.Enum enum
+    serialize _ (List list) = Just $ Type.List list
+    serialize _ (Object object) = Just
+        $ Type.Object
+        $ HashMap.fromList
+        $ OrderedMap.toList object
+    serialize _ _ = Nothing
+
+#ifdef WITH_JSON
 instance Serialize Aeson.Value where
     serialize (Out.ScalarBaseType scalarType) value
         | Type.ScalarType "Int" _ <- scalarType
@@ -236,3 +249,47 @@ instance Serialize Aeson.Value where
         $ 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

src/Language/GraphQL/Type/Schema.hs

@@ -205,5 +205,5 @@ collectImplementations = HashMap.foldr go HashMap.empty
         let Out.ObjectType _ _ interfaces _ = objectType
          in foldr (add implementation) accumulator interfaces
     go _ accumulator = accumulator
-    add implementation (Out.InterfaceType typeName _ _ _) accumulator =
-        HashMap.insertWith (++) typeName [implementation] accumulator
+    add implementation (Out.InterfaceType typeName _ _ _) =
+        HashMap.insertWith (++) typeName [implementation]

src/Language/GraphQL/Validate/Rules.hs

@@ -152,7 +152,7 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
   where
     errorMessage =
         "Anonymous Subscription must select only one top level field."
-    collectFields selectionSet = foldM forEach HashSet.empty selectionSet
+    collectFields = foldM forEach HashSet.empty
     forEach accumulator = \case
         Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
         Full.FragmentSpreadSelection fragmentSelection ->
@@ -472,7 +472,7 @@ noFragmentCyclesRule = FragmentDefinitionRule $ \case
     collectCycles :: Traversable t
         => t Full.Selection
         -> StateT (Int, Full.Name) (ReaderT (Validation m) Seq) (HashMap Full.Name Int)
-    collectCycles selectionSet = foldM forEach HashMap.empty selectionSet
+    collectCycles = foldM forEach HashMap.empty
     forEach accumulator = \case
         Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
         Full.InlineFragmentSelection fragmentSelection ->
@@ -702,8 +702,7 @@ uniqueInputFieldNamesRule =
   where
     go (Full.Node (Full.Object fields) _) = filterFieldDuplicates fields
     go _ = mempty
-    filterFieldDuplicates fields =
-        filterDuplicates getFieldName "input field" fields
+    filterFieldDuplicates = filterDuplicates getFieldName "input field"
     getFieldName (Full.ObjectField fieldName _ location') = (fieldName, location')
     constGo (Full.Node (Full.ConstObject fields) _) = filterFieldDuplicates fields
     constGo _ = mempty
@@ -1331,8 +1330,8 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case
         -> Type.CompositeType m
         -> t Full.Selection
         -> ValidationState m (Seq Error)
-    visitSelectionSet variables selectionType selections =
-        foldM (evaluateSelection variables selectionType) mempty selections
+    visitSelectionSet variables selectionType =
+        foldM (evaluateSelection variables selectionType) mempty
     evaluateFieldSelection variables selections accumulator = \case
         Just newParentType -> do
             let folder = evaluateSelection variables newParentType
@@ -1617,4 +1616,3 @@ valuesOfCorrectTypeRule = ValueRule go constGo
                         }
                 | otherwise -> mempty
             _ -> checkResult
-

src/Test/Hspec/GraphQL.hs

@@ -2,6 +2,9 @@
    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 #-}
 
@@ -39,3 +42,8 @@ shouldResolve executor query = do
             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
+    (
+    ) where
+#endif

tests/Language/GraphQL/ErrorSpec.hs

@@ -7,9 +7,9 @@ module Language.GraphQL.ErrorSpec
     ( spec
     ) where
 
-import qualified Data.Aeson as Aeson
 import Data.List.NonEmpty (NonEmpty (..))
 import Language.GraphQL.Error
+import qualified Language.GraphQL.Type as Type
 import Test.Hspec
     ( Spec
     , describe
@@ -31,6 +31,6 @@ spec = describe "parseError" $
                 , pstateTabWidth = mkPos 1
                 , pstateLinePrefix = ""
                 }
-        Response Aeson.Null actual <-
+        Response Type.Null actual <-
             parseError (ParseErrorBundle parseErrors posState)
         length actual `shouldBe` 1

tests/Language/GraphQL/Execute/CoerceSpec.hs

@@ -7,12 +7,8 @@ module Language.GraphQL.Execute.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.Type
 import qualified Language.GraphQL.Type.In as In
@@ -27,81 +23,11 @@ direction = EnumType "Direction" Nothing  $ HashMap.fromList
     , ("WEST", EnumValue Nothing)
     ]
 
-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 = do
-    describe "VariableValue Aeson" $ do
-        it "coerces strings" $
-            let expected = Just (String "asdf")
-                actual = Coerce.coerceVariableValue
-                    (In.NamedScalarType string) (Aeson.String "asdf")
-             in actual `shouldBe` expected
-        it "coerces non-null strings" $
-            let expected = Just (String "asdf")
-                actual = Coerce.coerceVariableValue
-                    (In.NonNullScalarType string) (Aeson.String "asdf")
-             in actual `shouldBe` expected
-        it "coerces booleans" $
-            let expected = Just (Boolean True)
-                actual = Coerce.coerceVariableValue
-                    (In.NamedScalarType boolean) (Aeson.Bool True)
-             in actual `shouldBe` expected
-        it "coerces zero to an integer" $
-            let expected = Just (Int 0)
-                actual = Coerce.coerceVariableValue
-                    (In.NamedScalarType int) (Aeson.Number 0)
-             in actual `shouldBe` expected
-        it "rejects fractional if an integer is expected" $
-            let actual = Coerce.coerceVariableValue
-                    (In.NamedScalarType int) (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) (Aeson.Number $ scientific 14 (-1))
-             in actual `shouldBe` expected
-        it "coerces IDs" $
-            let expected = Just (String "1234")
-                json = Aeson.String "1234"
-                actual = Coerce.coerceVariableValue namedIdType json
-             in actual `shouldBe` expected
-        it "coerces input objects" $
-            let actual = Coerce.coerceVariableValue singletonInputObject
-                    $ 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 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
-                    $ Aeson.object variableFields
-                variableFields =
-                    [ "field" .= ("asdf" :: Aeson.Value)
-                    , "extra" .= ("qwer" :: Aeson.Value)
-                    ]
-             in actual `shouldSatisfy` isNothing
-        it "preserves null" $
-            let actual = Coerce.coerceVariableValue namedIdType Aeson.Null
-             in actual `shouldBe` Just Null
-        it "preserves list order" $
-            let list = 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
-
+spec =
     describe "coerceInputLiteral" $ do
         it "coerces enums" $
             let expected = Just (Enum "NORTH")

tests/Language/GraphQL/ExecuteSpec.hs

@@ -10,9 +10,6 @@ module Language.GraphQL.ExecuteSpec
 
 import Control.Exception (Exception(..), SomeException)
 import Control.Monad.Catch (throwM)
-import Data.Aeson ((.=))
-import qualified Data.Aeson as Aeson
-import Data.Aeson.Types (emptyObject)
 import Data.Conduit
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
@@ -189,12 +186,12 @@ schoolType = EnumType "School" Nothing $ HashMap.fromList
     ]
 
 type EitherStreamOrValue = Either
-    (ResponseEventStream (Either SomeException) Aeson.Value)
-    (Response Aeson.Value)
+    (ResponseEventStream (Either SomeException) Value)
+    (Response Value)
 
 execute' :: Document -> Either SomeException EitherStreamOrValue
 execute' =
-    execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value)
+    execute philosopherSchema Nothing (mempty :: HashMap Name Value)
 
 spec :: Spec
 spec =
@@ -209,38 +206,37 @@ spec =
                 ...cyclicFragment
               }
             |]
-                expected = Response emptyObject mempty
+                expected = Response (Object mempty) mempty
                 Right (Right actual) = either (pure . parseError) execute'
                     $ parse document "" sourceQuery
              in actual `shouldBe` expected
 
         context "Query" $ do
             it "skips unknown fields" $
-                let data'' = Aeson.object
-                        [ "philosopher" .= Aeson.object
-                            [ "firstName" .= ("Friedrich" :: String)
-                            ]
-                        ]
+                let data'' = Object
+                        $ HashMap.singleton "philosopher"
+                        $ Object
+                        $ HashMap.singleton "firstName"
+                        $ String "Friedrich"
                     expected = Response data'' mempty
                     Right (Right actual) = either (pure . parseError) execute'
                         $ parse document "" "{ philosopher { firstName surname } }"
                 in actual `shouldBe` expected
             it "merges selections" $
-                let data'' = Aeson.object
-                        [ "philosopher" .= Aeson.object
-                            [ "firstName" .= ("Friedrich" :: String)
-                            , "lastName" .= ("Nietzsche" :: String)
+                let data'' = Object
+                        $ HashMap.singleton "philosopher"
+                        $ Object
+                        $ HashMap.fromList
+                            [ ("firstName", String "Friedrich")
+                            , ("lastName", String "Nietzsche")
                             ]
-                        ]
                     expected = Response data'' mempty
                     Right (Right actual) = either (pure . parseError) execute'
                         $ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
                 in actual `shouldBe` expected
 
             it "errors on invalid output enum values" $
-                let data'' = Aeson.object
-                        [ "philosopher" .= Aeson.Null
-                        ]
+                let data'' = Object $ HashMap.singleton "philosopher" Null
                     executionErrors = pure $ Error
                         { message =
                             "Value completion error. Expected type !School, found: EXISTENTIALISM."
@@ -253,9 +249,7 @@ spec =
                 in actual `shouldBe` expected
 
             it "gives location information for non-null unions" $
-                let data'' = Aeson.object
-                        [ "philosopher" .= Aeson.Null
-                        ]
+                let data'' = Object $ HashMap.singleton "philosopher" Null
                     executionErrors = pure $ Error
                         { message =
                             "Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."
@@ -268,9 +262,7 @@ spec =
                 in actual `shouldBe` expected
 
             it "gives location information for invalid interfaces" $
-                let data'' = Aeson.object
-                        [ "philosopher" .= Aeson.Null
-                        ]
+                let data'' = Object $ HashMap.singleton "philosopher" Null
                     executionErrors = pure $ Error
                         { message
                             = "Value completion error. Expected type !Work, found:\
@@ -284,9 +276,7 @@ spec =
                 in actual `shouldBe` expected
 
             it "gives location information for invalid scalar arguments" $
-                let data'' = Aeson.object
-                        [ "philosopher" .= Aeson.Null
-                        ]
+                let data'' = Object $ HashMap.singleton "philosopher" Null
                     executionErrors = pure $ Error
                         { message =
                             "Argument \"id\" has invalid type. Expected type ID, found: True."
@@ -299,9 +289,7 @@ spec =
                 in actual `shouldBe` expected
 
             it "gives location information for failed result coercion" $
-                let data'' = Aeson.object
-                        [ "philosopher" .= Aeson.Null
-                        ]
+                let data'' = Object $ HashMap.singleton "philosopher" Null
                     executionErrors = pure $ Error
                         { message = "Unable to coerce result to !Int."
                         , locations = [Location 1 26]
@@ -313,9 +301,7 @@ spec =
                 in actual `shouldBe` expected
 
             it "gives location information for failed result coercion" $
-                let data'' = Aeson.object
-                        [ "genres" .= Aeson.Null
-                        ]
+                let data'' = Object $ HashMap.singleton "genres" Null
                     executionErrors = pure $ Error
                         { message = "PhilosopherException"
                         , locations = [Location 1 3]
@@ -332,15 +318,13 @@ spec =
                         , locations = [Location 1 3]
                         , path = [Segment "count"]
                         }
-                    expected = Response Aeson.Null executionErrors
+                    expected = Response Null executionErrors
                     Right (Right actual) = either (pure . parseError) execute'
                         $ parse document "" "{ count }"
                 in actual `shouldBe` expected
 
             it "detects nullability errors" $
-                let data'' = Aeson.object
-                        [ "philosopher" .= Aeson.Null
-                        ]
+                let data'' = Object $ HashMap.singleton "philosopher" Null
                     executionErrors = pure $ Error
                         { message = "Value completion error. Expected type !String, found: null."
                         , locations = [Location 1 26]
@@ -353,11 +337,11 @@ spec =
 
         context "Subscription" $
             it "subscribes" $
-                let data'' = Aeson.object
-                        [ "newQuote" .= Aeson.object
-                            [ "quote" .= ("Naturam expelles furca, tamen usque recurret." :: String)
-                            ]
-                        ]
+                let data'' = Object
+                        $ HashMap.singleton "newQuote"
+                        $ Object
+                        $ HashMap.singleton "quote"
+                        $ String "Naturam expelles furca, tamen usque recurret."
                     expected = Response data'' mempty
                     Right (Left stream) = either (pure . parseError) execute'
                         $ parse document "" "subscription { newQuote { quote } }"

tests/Test/DirectiveSpec.hs

@@ -1,92 +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 QuasiQuotes #-}
-module Test.DirectiveSpec
-    ( spec
-    ) where
-
-import Data.Aeson (object, (.=))
-import qualified Data.Aeson as Aeson
-import qualified Data.HashMap.Strict as HashMap
-import Language.GraphQL
-import Language.GraphQL.TH
-import Language.GraphQL.Type
-import qualified Language.GraphQL.Type.Out as Out
-import Test.Hspec (Spec, describe, it)
-import Test.Hspec.GraphQL
-
-experimentalResolver :: Schema IO
-experimentalResolver = schema queryType Nothing Nothing mempty
-  where
-    queryType = Out.ObjectType "Query" Nothing []
-        $ HashMap.singleton "experimentalField"
-        $ 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
-        it "should be able to @skip fields" $ do
-            let sourceQuery = [gql|
-              {
-                experimentalField @skip(if: true)
-              }
-            |]
-
-            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldResolveTo` emptyObject
-
-        it "should not skip fields if @skip is false" $ do
-            let sourceQuery = [gql|
-              {
-                experimentalField @skip(if: false)
-              }
-            |]
-                expected = HashMap.singleton "data"
-                    $ object
-                        [ "experimentalField" .= (5 :: Int)
-                        ]
-            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldResolveTo` expected
-
-        it "should skip fields if @include is false" $ do
-            let sourceQuery = [gql|
-              {
-                experimentalField @include(if: false)
-              }
-            |]
-
-            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldResolveTo` emptyObject
-
-        it "should be able to @skip a fragment spread" $ do
-            let sourceQuery = [gql|
-              {
-                ...experimentalFragment @skip(if: true)
-              }
-
-              fragment experimentalFragment on Query {
-                experimentalField
-              }
-            |]
-
-            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldResolveTo` emptyObject
-
-        it "should be able to @skip an inline fragment" $ do
-            let sourceQuery = [gql|
-              {
-                ... on Query @skip(if: true) {
-                  experimentalField
-                }
-              }
-            |]
-
-            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldResolveTo` emptyObject

tests/Test/FragmentSpec.hs

@@ -1,204 +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 QuasiQuotes #-}
-module Test.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
-import Language.GraphQL.Type
-import qualified Language.GraphQL.Type.Out as Out
-import Language.GraphQL.TH
-import Test.Hspec (Spec, describe, it)
-import Test.Hspec.GraphQL
-
-size :: (Text, Value)
-size = ("size", String "L")
-
-circumference :: (Text, Value)
-circumference = ("circumference", Int 60)
-
-garment :: Text -> (Text, Value)
-garment typeName =
-    ("garment",  Object $ HashMap.fromList
-        [ if typeName == "Hat" then circumference else size
-        , ("__typename", String typeName)
-        ]
-    )
-
-inlineQuery :: Text
-inlineQuery = [gql|
-  {
-    garment {
-      ... on Hat {
-        circumference
-      }
-      ... on Shirt {
-        size
-      }
-    }
-  }
-|]
-
-shirtType :: Out.ObjectType IO
-shirtType = Out.ObjectType "Shirt" Nothing [] $ HashMap.fromList
-    [ ("size", sizeFieldType)
-    ]
-
-hatType :: Out.ObjectType IO
-hatType = Out.ObjectType "Hat" Nothing [] $ HashMap.fromList
-    [ ("size", sizeFieldType)
-    , ("circumference", circumferenceFieldType)
-    ]
-
-circumferenceFieldType :: Out.Resolver IO
-circumferenceFieldType
-    = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
-    $ pure $ snd circumference
-
-sizeFieldType :: Out.Resolver IO
-sizeFieldType
-    = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
-    $ pure $ snd size
-
-toSchema :: Text -> (Text, Value) -> Schema IO
-toSchema t (_, resolve) = schema queryType Nothing Nothing mempty
-  where
-    garmentType = Out.UnionType "Garment" Nothing [hatType, shirtType]
-    typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
-    garmentField = Out.Field Nothing (Out.NamedUnionType garmentType) mempty
-    queryType =
-        case t of
-            "circumference" -> hatType
-            "size" -> shirtType
-            _ -> Out.ObjectType "Query" Nothing []
-                $ HashMap.fromList
-                    [ ("garment", ValueResolver garmentField (pure resolve))
-                    , ("__typename", ValueResolver typeNameField (pure $ String "Shirt"))
-                    ]
-
-spec :: Spec
-spec = do
-    describe "Inline fragment executor" $ do
-        it "chooses the first selection if the type matches" $ do
-            actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery
-            let expected = HashMap.singleton "data"
-                    $ Aeson.object
-                        [ "garment" .= Aeson.object
-                            [ "circumference" .= (60 :: Int)
-                            ]
-                        ]
-             in actual `shouldResolveTo` expected
-
-        it "chooses the last selection if the type matches" $ do
-            actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
-            let expected = HashMap.singleton "data"
-                    $ Aeson.object
-                        [ "garment" .= Aeson.object
-                            [ "size" .= ("L" :: Text)
-                            ]
-                        ]
-             in actual `shouldResolveTo` expected
-
-        it "embeds inline fragments without type" $ do
-            let sourceQuery = [gql|
-              {
-                circumference
-                ... {
-                  size
-                }
-              }
-            |]
-            actual <- graphql (toSchema "circumference" circumference) sourceQuery
-            let expected = HashMap.singleton "data"
-                    $ Aeson.object
-                        [ "circumference" .= (60 :: Int)
-                        , "size" .= ("L" :: Text)
-                        ]
-             in actual `shouldResolveTo` expected
-
-        it "evaluates fragments on Query" $ do
-            let sourceQuery = [gql|
-              {
-                ... {
-                  size
-                }
-              }
-            |]
-             in graphql (toSchema "size" size) `shouldResolve` sourceQuery
-
-    describe "Fragment spread executor" $ do
-        it "evaluates fragment spreads" $ do
-            let sourceQuery = [gql|
-              {
-                ...circumferenceFragment
-              }
-
-              fragment circumferenceFragment on Hat {
-                circumference
-              }
-            |]
-
-            actual <- graphql (toSchema "circumference" circumference) sourceQuery
-            let expected = HashMap.singleton "data"
-                    $ Aeson.object
-                        [ "circumference" .= (60 :: Int)
-                        ]
-             in actual `shouldResolveTo` expected
-
-        it "evaluates nested fragments" $ do
-            let sourceQuery = [gql|
-              {
-                garment {
-                  ...circumferenceFragment
-                }
-              }
-
-              fragment circumferenceFragment on Hat {
-                ...hatFragment
-              }
-
-              fragment hatFragment on Hat {
-                circumference
-              }
-            |]
-
-            actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
-            let expected = HashMap.singleton "data"
-                    $ Aeson.object
-                        [ "garment" .= Aeson.object
-                            [ "circumference" .= (60 :: Int)
-                            ]
-                        ]
-             in actual `shouldResolveTo` expected
-
-        it "considers type condition" $ do
-            let sourceQuery = [gql|
-              {
-                garment {
-                  ...circumferenceFragment
-                  ...sizeFragment
-                }
-              }
-              fragment circumferenceFragment on Hat {
-                circumference
-              }
-              fragment sizeFragment on Shirt {
-                size
-              }
-            |]
-                expected = HashMap.singleton "data"
-                    $ Aeson.object
-                        [ "garment" .= Aeson.object
-                            [ "circumference" .= (60 :: Int)
-                            ]
-                        ]
-            actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
-            actual `shouldResolveTo` expected

tests/Test/RootOperationSpec.hs

@@ -1,72 +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 QuasiQuotes #-}
-module Test.RootOperationSpec
-    ( spec
-    ) where
-
-import Data.Aeson ((.=), object)
-import qualified Data.HashMap.Strict as HashMap
-import Language.GraphQL
-import Test.Hspec (Spec, describe, it)
-import Language.GraphQL.TH
-import Language.GraphQL.Type
-import qualified Language.GraphQL.Type.Out as Out
-import Test.Hspec.GraphQL
-
-hatType :: Out.ObjectType IO
-hatType = Out.ObjectType "Hat" Nothing []
-    $ HashMap.singleton "circumference"
-    $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
-    $ pure $ Int 60
-
-garmentSchema :: Schema IO
-garmentSchema = schema queryType (Just mutationType) Nothing mempty
-  where
-    queryType = Out.ObjectType "Query" Nothing [] hatFieldResolver
-    mutationType = Out.ObjectType "Mutation" Nothing [] incrementFieldResolver
-    garment = pure $ Object $ HashMap.fromList
-        [ ("circumference", Int 60)
-        ]
-    incrementFieldResolver = HashMap.singleton "incrementCircumference"
-        $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
-        $ pure $ Int 61
-    hatField = Out.Field Nothing (Out.NamedObjectType hatType) mempty
-    hatFieldResolver =
-        HashMap.singleton "garment" $ ValueResolver hatField garment
-
-spec :: Spec
-spec =
-    describe "Root operation type" $ do
-        it "returns objects from the root resolvers" $ do
-            let querySource = [gql|
-              {
-                garment {
-                  circumference
-                }
-              }
-            |]
-                expected = HashMap.singleton "data"
-                    $ object
-                        [ "garment" .= object
-                            [ "circumference" .= (60 :: Int)
-                            ]
-                        ]
-            actual <- graphql garmentSchema querySource
-            actual `shouldResolveTo` expected
-
-        it "chooses Mutation" $ do
-            let querySource = [gql|
-              mutation {
-                incrementCircumference
-              }
-            |]
-                expected = HashMap.singleton "data"
-                    $ object
-                        [ "incrementCircumference" .= (61 :: Int)
-                        ]
-            actual <- graphql garmentSchema querySource
-            actual `shouldResolveTo` expected