Release 1.0.0.0

CHANGELOG.md

@@ -6,4 +6,7 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
-## [Unreleased]
+## [1.0.0.0] - 2022-03-29
+### Added
+- JSON serialization.
+- Test helpers.

cabal.project

@@ -1,9 +1,4 @@
 packages:
   .
 
-source-repository-package
-  type: git
-  location: git://caraus.tech/pub/graphql.git
-  tag: 8503c0f288201223776f9962438c577241f08c9d
-
 constraints: graphql -json

graphql-spice.cabal

@@ -31,12 +31,12 @@ library
     ghc-options: -Wall
     build-depends:
       aeson ^>= 2.0.3,
-      base ^>=4.14.3.0,
+      base >= 4.7 && < 5,
       conduit ^>= 1.3.4,
       containers ^>= 0.6.2,
       exceptions ^>= 0.10.4,
       hspec-expectations >= 0.8.2 && < 0.9,
-      graphql ^>= 1.0.2,
+      graphql ^>= 1.0.3.0,
       megaparsec >= 9.0 && < 10,
       scientific ^>= 0.3.7,
       text >= 1.2 && < 3,
@@ -48,6 +48,7 @@ test-suite graphql-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+    Language.GraphQL.CoerceSpec
     Language.GraphQL.DirectiveSpec
     Language.GraphQL.FragmentSpec
     Language.GraphQL.RootOperationSpec
@@ -56,10 +57,11 @@ test-suite graphql-test
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
   build-depends:
     aeson,
-    base >= 4.8 && < 5,
+    base,
     graphql,
     graphql-spice,
     hspec >= 2.9.1 && < 3,
+    scientific,
     text,
     unordered-containers
   default-language: Haskell2010

src/Language/GraphQL/JSON.hs

@@ -1,7 +1,12 @@
+{- 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
@@ -31,6 +36,7 @@ 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
@@ -111,7 +117,7 @@ instance VariableValue JSON where
         foldVector _ Nothing = Nothing
         foldVector variableValue (Just list) = do
             coerced <- coerceVariableValue listType $ JSON variableValue
-            pure $ coerced : list 
+            pure $ coerced : list
     coerceVariableValue _ _ = Nothing
 
 -- | If the text parses correctly as a @GraphQL@ query the query is

tests/Language/GraphQL/CoerceSpec.hs

@@ -0,0 +1,98 @@
+{- 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