{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Language.GraphQL.Execute.Coerce
( Output(..)
, Serialize(..)
, VariableValue(..)
, coerceInputLiteral
, matchFieldValues
) where
import Data.Int (Int32)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
import Language.GraphQL.AST (Name)
import Language.GraphQL.Execute.OrderedMap (OrderedMap)
import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
class VariableValue a where
coerceVariableValue
:: In.Type
-> a
-> Maybe Type.Value
instance VariableValue Type.Value where
coerceVariableValue :: Type -> Value -> Maybe Value
coerceVariableValue Type
_ Value
Type.Null = forall a. a -> Maybe a
Just Value
Type.Null
coerceVariableValue (In.ScalarBaseType ScalarType
_) Value
value = forall a. a -> Maybe a
Just Value
value
coerceVariableValue (In.EnumBaseType EnumType
_) (Type.Enum Name
stringValue) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
stringValue
coerceVariableValue (In.InputObjectBaseType InputObjectType
objectType) Value
value
| (Type.Object HashMap Name Value
objectValue) <- Value
value = do
let (In.InputObjectType Name
_ Maybe Name
_ HashMap Name InputField
inputFields) = InputObjectType
objectType
(HashMap Name Value
newObjectValue, HashMap Name Value
resultMap) <- forall {a} {k}.
(VariableValue a, Hashable k) =>
HashMap k a
-> HashMap k InputField -> Maybe (HashMap k a, HashMap k Value)
foldWithKey HashMap Name Value
objectValue HashMap Name InputField
inputFields
if forall k v. HashMap k v -> Bool
HashMap.null HashMap Name Value
newObjectValue
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ HashMap Name Value -> Value
Type.Object HashMap Name Value
resultMap
else forall a. Maybe a
Nothing
where
foldWithKey :: HashMap k a
-> HashMap k InputField -> Maybe (HashMap k a, HashMap k Value)
foldWithKey HashMap k a
objectValue = forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey forall {k} {a}.
(VariableValue a, Hashable k) =>
k
-> InputField
-> Maybe (HashMap k a, HashMap k Value)
-> Maybe (HashMap k a, HashMap k Value)
matchFieldValues'
forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (HashMap k a
objectValue, forall k v. HashMap k v
HashMap.empty)
matchFieldValues' :: k
-> InputField
-> Maybe (HashMap k a, HashMap k Value)
-> Maybe (HashMap k a, HashMap k Value)
matchFieldValues' k
_ InputField
_ Maybe (HashMap k a, HashMap k Value)
Nothing = forall a. Maybe a
Nothing
matchFieldValues' k
fieldName InputField
inputField (Just (HashMap k a
objectValue, HashMap k Value
resultMap)) =
let (In.InputField Maybe Name
_ Type
fieldType Maybe Value
_) = InputField
inputField
insert :: Value -> HashMap k Value
insert = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
fieldName) HashMap k Value
resultMap
newObjectValue :: HashMap k a
newObjectValue = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete k
fieldName HashMap k a
objectValue
in case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
fieldName HashMap k a
objectValue of
Just a
variableValue -> do
Value
coerced <- forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
fieldType a
variableValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap k a
newObjectValue, Value -> HashMap k Value
insert Value
coerced)
Maybe a
Nothing -> forall a. a -> Maybe a
Just (HashMap k a
objectValue, HashMap k Value
resultMap)
coerceVariableValue (In.ListBaseType Type
listType) Value
value
| (Type.List [Value]
arrayValue) <- Value
value =
[Value] -> Value
Type.List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
listType) [Value]
arrayValue
| Bool
otherwise = forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
listType Value
value
coerceVariableValue Type
_ Value
_ = forall a. Maybe a
Nothing
matchFieldValues :: forall a
. (In.Type -> a -> Maybe Type.Value)
-> HashMap Name a
-> Name
-> In.Type
-> Maybe Type.Value
-> Maybe (HashMap Name Type.Value)
-> Maybe (HashMap Name Type.Value)
matchFieldValues :: forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value)
matchFieldValues Type -> a -> Maybe Value
coerce HashMap Name a
values' Name
fieldName Type
type' Maybe Value
defaultValue Maybe (HashMap Name Value)
resultMap =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
fieldName HashMap Name a
values' of
Just a
variableValue -> Maybe Value -> Maybe (HashMap Name Value)
coerceRuntimeValue forall a b. (a -> b) -> a -> b
$ Type -> a -> Maybe Value
coerce Type
type' a
variableValue
Maybe a
Nothing
| Just Value
value <- Maybe Value
defaultValue ->
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
fieldName Value
value forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HashMap Name Value)
resultMap
| Maybe Value
Nothing <- Maybe Value
defaultValue
, Type -> Bool
In.isNonNullType Type
type' -> forall a. Maybe a
Nothing
| Bool
otherwise -> Maybe (HashMap Name Value)
resultMap
where
coerceRuntimeValue :: Maybe Value -> Maybe (HashMap Name Value)
coerceRuntimeValue (Just Value
Type.Null)
| Type -> Bool
In.isNonNullType Type
type' = forall a. Maybe a
Nothing
coerceRuntimeValue Maybe Value
coercedValue =
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
fieldName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
coercedValue forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (HashMap Name Value)
resultMap
coerceInputLiteral :: In.Type -> Type.Value -> Maybe Type.Value
coerceInputLiteral :: Type -> Value -> Maybe Value
coerceInputLiteral (Type -> Bool
In.isNonNullType -> Bool
False) Value
Type.Null = forall a. a -> Maybe a
Just Value
Type.Null
coerceInputLiteral (In.ScalarBaseType ScalarType
type') Value
value
| (Type.String Name
stringValue) <- Value
value
, (Type.ScalarType Name
"String" Maybe Name
_) <- ScalarType
type' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
stringValue
| (Type.Boolean Bool
booleanValue) <- Value
value
, (Type.ScalarType Name
"Boolean" Maybe Name
_) <- ScalarType
type' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> Value
Type.Boolean Bool
booleanValue
| (Type.Int Int32
intValue) <- Value
value
, (Type.ScalarType Name
"Int" Maybe Name
_) <- ScalarType
type' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int32 -> Value
Type.Int Int32
intValue
| (Type.Float Double
floatValue) <- Value
value
, (Type.ScalarType Name
"Float" Maybe Name
_) <- ScalarType
type' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Value
Type.Float Double
floatValue
| (Type.Int Int32
intValue) <- Value
value
, (Type.ScalarType Name
"Float" Maybe Name
_) <- ScalarType
type' =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Value
Type.Float forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
intValue
| (Type.String Name
stringValue) <- Value
value
, (Type.ScalarType Name
"ID" Maybe Name
_) <- ScalarType
type' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
stringValue
| (Type.Int Int32
intValue) <- Value
value
, (Type.ScalarType Name
"ID" Maybe Name
_) <- ScalarType
type' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int32 -> Value
decimal Int32
intValue
where
decimal :: Int32 -> Value
decimal = Name -> Value
Type.String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Name
Text.Lazy.toStrict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Text.Builder.toLazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Builder
Text.Builder.decimal
coerceInputLiteral (In.EnumBaseType EnumType
type') (Type.Enum Name
enumValue)
| Name -> EnumType -> Bool
member Name
enumValue EnumType
type' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
enumValue
where
member :: Name -> EnumType -> Bool
member Name
value (Type.EnumType Name
_ Maybe Name
_ HashMap Name EnumValue
members) = forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Name
value HashMap Name EnumValue
members
coerceInputLiteral (In.InputObjectBaseType InputObjectType
type') (Type.Object HashMap Name Value
values) =
let (In.InputObjectType Name
_ Maybe Name
_ HashMap Name InputField
inputFields) = InputObjectType
type'
in HashMap Name Value -> Value
Type.Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey (HashMap Name Value
-> Name
-> InputField
-> Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value)
matchFieldValues' HashMap Name Value
values) (forall a. a -> Maybe a
Just forall k v. HashMap k v
HashMap.empty) HashMap Name InputField
inputFields
where
matchFieldValues' :: HashMap Name Value
-> Name
-> InputField
-> Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value)
matchFieldValues' HashMap Name Value
values' Name
fieldName (In.InputField Maybe Name
_ Type
inputFieldType Maybe Value
defaultValue) =
forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value)
matchFieldValues Type -> Value -> Maybe Value
coerceInputLiteral HashMap Name Value
values' Name
fieldName Type
inputFieldType Maybe Value
defaultValue
coerceInputLiteral (In.ListBaseType Type
listType) (Type.List [Value]
list) =
[Value] -> Value
Type.List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Type -> Value -> Maybe Value
coerceInputLiteral Type
listType) [Value]
list
coerceInputLiteral (In.ListBaseType Type
listType) Value
singleton =
Type -> Value -> Maybe Value
wrapSingleton Type
listType Value
singleton
where
wrapSingleton :: Type -> Value -> Maybe Value
wrapSingleton (In.ListBaseType Type
listType') Value
singleton' =
[Value] -> Value
Type.List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Type -> Value -> Maybe Value
wrapSingleton Type
listType' Value
singleton']
wrapSingleton Type
listType' Value
singleton' =
[Value] -> Value
Type.List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Type -> Value -> Maybe Value
coerceInputLiteral Type
listType' Value
singleton']
coerceInputLiteral Type
_ Value
_ = forall a. Maybe a
Nothing
class Serialize a where
serialize :: forall m
. Out.Type m
-> Output a
-> Maybe a
null :: a
data Output a
= Int Int32
| Float Double
| String Text
| Boolean Bool
| Enum Name
| List [a]
| Object (OrderedMap a)
deriving (Output a -> Output a -> Bool
forall a. Eq a => Output a -> Output a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Output a -> Output a -> Bool
$c/= :: forall a. Eq a => Output a -> Output a -> Bool
== :: Output a -> Output a -> Bool
$c== :: forall a. Eq a => Output a -> Output a -> Bool
Eq, Int -> Output a -> ShowS
forall a. Show a => Int -> Output a -> ShowS
forall a. Show a => [Output a] -> ShowS
forall a. Show a => Output a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output a] -> ShowS
$cshowList :: forall a. Show a => [Output a] -> ShowS
show :: Output a -> String
$cshow :: forall a. Show a => Output a -> String
showsPrec :: Int -> Output a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Output a -> ShowS
Show)
instance forall a. IsString (Output a) where
fromString :: String -> Output a
fromString = forall a. Name -> Output a
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
instance Serialize Type.Value where
null :: Value
null = Value
Type.Null
serialize :: forall (m :: * -> *). Type m -> Output Value -> Maybe Value
serialize (Out.ScalarBaseType ScalarType
scalarType) Output Value
value
| Type.ScalarType Name
"Int" Maybe Name
_ <- ScalarType
scalarType
, Int Int32
int <- Output Value
value = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int32 -> Value
Type.Int Int32
int
| Type.ScalarType Name
"Float" Maybe Name
_ <- ScalarType
scalarType
, Float Double
float <- Output Value
value = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Value
Type.Float Double
float
| Type.ScalarType Name
"String" Maybe Name
_ <- ScalarType
scalarType
, String Name
string <- Output Value
value = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
string
| Type.ScalarType Name
"ID" Maybe Name
_ <- ScalarType
scalarType
, String Name
string <- Output Value
value = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
string
| Type.ScalarType Name
"Boolean" Maybe Name
_ <- ScalarType
scalarType
, Boolean Bool
boolean <- Output Value
value = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> Value
Type.Boolean Bool
boolean
serialize Type m
_ (Enum Name
enum) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
enum
serialize Type m
_ (List [Value]
list) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Value] -> Value
Type.List [Value]
list
serialize Type m
_ (Object OrderedMap Value
object) = forall a. a -> Maybe a
Just
forall a b. (a -> b) -> a -> b
$ HashMap Name Value -> Value
Type.Object
forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
forall a b. (a -> b) -> a -> b
$ forall v. OrderedMap v -> [(Name, v)]
OrderedMap.toList OrderedMap Value
object
serialize Type m
_ Output Value
_ = forall a. Maybe a
Nothing