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