diff --git a/graphql-spice.cabal b/graphql-spice.cabal index 0622ea7..a56d044 100644 --- a/graphql-spice.cabal +++ b/graphql-spice.cabal @@ -32,7 +32,10 @@ library build-depends: aeson ^>= 2.0.3, base ^>=4.14.3.0, - graphql ^>= 1.0.2 + graphql ^>= 1.0.2, + scientific ^>= 0.3.7, + text ^>= 1.2.5, + unordered-containers ^>= 0.2.16 default-language: Haskell2010 test-suite graphql-test diff --git a/src/Language/GraphQL/Serialize.hs b/src/Language/GraphQL/Serialize.hs index 1d7675b..38a7ec7 100644 --- a/src/Language/GraphQL/Serialize.hs +++ b/src/Language/GraphQL/Serialize.hs @@ -6,8 +6,15 @@ module Language.GraphQL.Serialize import qualified Data.Aeson as Aeson import qualified Data.Aeson.Key as Aeson.Key +import qualified Data.Aeson.KeyMap as KeyMap +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.Scientific (toBoundedInteger, toRealFloat) +import Data.Text (Text) +import Language.GraphQL.AST (Name) import Language.GraphQL.Execute.Coerce import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap +import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.Out as Out import qualified Language.GraphQL.Type as Type @@ -41,3 +48,54 @@ instance Serialize JSON where toJSONKeyValue (key, value) = (Aeson.Key.fromText key, Aeson.toJSON value) serialize _ _ = Nothing null = JSON 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 KeyMap.null newObjectValue + then Just $ Type.Object resultMap + else Nothing + where + foldWithKey :: Aeson.Object + -> HashMap Name In.InputField + -> Maybe (Aeson.Object, HashMap Name Type.Value) + foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues' + $ Just (objectValue, HashMap.empty) + matchFieldValues' :: Text + -> In.InputField + -> Maybe (Aeson.Object, HashMap Name Type.Value) + -> Maybe (Aeson.Object, HashMap Name Type.Value) + matchFieldValues' _ _ Nothing = Nothing + matchFieldValues' fieldName inputField (Just (objectValue, resultMap)) = + let fieldKey = Aeson.Key.fromText fieldName + In.InputField _ fieldType _ = inputField + insert = flip (HashMap.insert fieldName) resultMap + newObjectValue = KeyMap.delete fieldKey objectValue + in case KeyMap.lookup fieldKey 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