summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2022-03-29 20:20:19 +0200
committerEugen Wissner <belka@caraus.de>2022-03-29 20:39:26 +0200
commit1d7f016b9c19dc4ce5b058b2a6d248eaa61ac0e6 (patch)
treee87b368ed7224cb7fdcc045e9ba48daef05107c4
parentc93c64a7f4828a202770b1cfadc79f28aba1da99 (diff)
downloadgraphql-spice-1.0.0.0.tar.gz
Release 1.0.0.0v1.0.0.0
-rw-r--r--CHANGELOG.md5
-rw-r--r--cabal.project5
-rw-r--r--graphql-spice.cabal8
-rw-r--r--src/Language/GraphQL/JSON.hs8
-rw-r--r--tests/Language/GraphQL/CoerceSpec.hs98
5 files changed, 114 insertions, 10 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index dfcb1f7..8366c2e 100644
--- a/CHANGELOG.md
+++ b/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.
diff --git a/cabal.project b/cabal.project
index 995ffa8..6d2c14d 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,9 +1,4 @@
packages:
.
-source-repository-package
- type: git
- location: git://caraus.tech/pub/graphql.git
- tag: 8503c0f288201223776f9962438c577241f08c9d
-
constraints: graphql -json
diff --git a/graphql-spice.cabal b/graphql-spice.cabal
index 35087c7..abaf140 100644
--- a/graphql-spice.cabal
+++ b/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
diff --git a/src/Language/GraphQL/JSON.hs b/src/Language/GraphQL/JSON.hs
index bdbc4f4..2a59e7b 100644
--- a/src/Language/GraphQL/JSON.hs
+++ b/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
diff --git a/tests/Language/GraphQL/CoerceSpec.hs b/tests/Language/GraphQL/CoerceSpec.hs
new file mode 100644
index 0000000..8bf11f1
--- /dev/null
+++ b/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