Merge pull request #194 from jamesdabbs/jcd/fix-generics

Add tests for generic fixes

Author: teh

Diff for: src/GraphQL/Internal/Value/FromValue.hs

@@ -100,15 +100,12 @@ instance forall dataName consName records s l p.
                          )) where
   genericFromValue o = M1 . M1 <$> genericFromValue @records o
 
-instance forall wrappedType fieldName rest u s l.
-  ( KnownSymbol fieldName
-  , FromValue wrappedType
-  , GenericFromValue rest
-  ) => GenericFromValue (S1 ('MetaSel ('Just fieldName) u s l) (Rec0 wrappedType) :*: rest) where
-  genericFromValue object = do
-    l <- getValue @wrappedType @fieldName object
-    r <- genericFromValue @rest object
-    pure (l :*: r)
+
+instance forall l r.
+  ( GenericFromValue l
+  , GenericFromValue r
+  ) => GenericFromValue (l :*: r) where
+  genericFromValue object = liftA2 (:*:) (genericFromValue @l object) (genericFromValue @r object)
 
 -- | Look up a single record field element in the Object.
 getValue :: forall wrappedType fieldName u s l p. (FromValue wrappedType, KnownSymbol fieldName)

Diff for: tests/ValueTests.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 module ValueTests (tests) where
 
 import Protolude
@@ -11,15 +12,24 @@ import qualified GraphQL.Internal.Syntax.AST as AST
 import GraphQL.Internal.Arbitrary (arbitraryText, arbitraryNonEmpty)
 import GraphQL.Value
   ( Object
+  , Value'(ValueObject')
   , ObjectField'(..)
   , astToVariableValue
   , unionObjects
   , objectFields
   , objectFromList
   , toValue
   )
-import GraphQL.Internal.Value.FromValue (prop_roundtripValue)
+import GraphQL.Internal.Value.FromValue (FromValue(..), prop_roundtripValue)
 
+data Resource = Resource
+    { resText     :: Text
+    , resInt      :: Int32
+    , resDouble   :: Double
+    , resBool     :: Bool
+    } deriving (Generic, Eq, Show)
+
+instance FromValue Resource
 
 tests :: IO TestTree
 tests = testSpec "Value" $ do
@@ -47,6 +57,23 @@ tests = testSpec "Value" $ do
   describe "Objects" $ do
     prop "have unique fields" $ do
       prop_fieldsUnique
+    -- See https://github.com/haskell-graphql/graphql-api/pull/178 for background
+    it "derives fromValue instances for objects with more than three fields" $ do
+      let Just value = objectFromList 
+            [ ("resText",   toValue @Text "text")
+            , ("resBool",   toValue @Bool False)
+            , ("resDouble", toValue @Double 1.2)
+            , ("resInt",    toValue @Int32 32)
+            ]
+      let Right observed = fromValue $ ValueObject' value
+      let expected = Resource
+            { resText   = "text"
+            , resInt    = 32
+            , resDouble = 1.2
+            , resBool   = False 
+            }
+      observed `shouldBe` expected
+      
   describe "ToValue / FromValue instances" $ do
     prop "Bool" $ prop_roundtripValue @Bool
     prop "Int32" $ prop_roundtripValue @Int32