{-# language DataKinds #-}
{-# language FlexibleInstances #-}
{-# language PolyKinds #-}
{-# language ScopedTypeVariables #-}
{-# language TupleSections #-}
{-# language TypeApplications #-}
{-# language TypeOperators #-}
{-# language ViewPatterns #-}
module Mu.GraphQL.Annotations (
ValueConst(..)
, DefaultValue
, ReflectValueConst(..)
, fromGQLValueConst
) where
import Control.Applicative (Alternative (..))
import Data.Coerce
import Data.Proxy
import qualified Data.Text as T
import GHC.TypeLits
import qualified Language.GraphQL.Draft.Syntax as GQL
data DefaultValue (v :: ValueConst Nat Symbol)
data ValueConst nat symbol
= VCInt nat
| VCString symbol
| VCBoolean Bool
| VCNull
| VCEnum symbol
| VCList [ValueConst nat symbol]
| VCObject [(symbol, ValueConst nat symbol)]
fromGQLValueConst :: forall f. Alternative f
=> GQL.ValueConst -> f (ValueConst Integer String)
fromGQLValueConst :: ValueConst -> f (ValueConst Integer String)
fromGQLValueConst (GQL.VCInt n :: Int32
n)
= ValueConst Integer String -> f (ValueConst Integer String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueConst Integer String -> f (ValueConst Integer String))
-> ValueConst Integer String -> f (ValueConst Integer String)
forall a b. (a -> b) -> a -> b
$ Integer -> ValueConst Integer String
forall nat symbol. nat -> ValueConst nat symbol
VCInt (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n)
fromGQLValueConst (GQL.VCString (StringValue -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
s))
= ValueConst Integer String -> f (ValueConst Integer String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueConst Integer String -> f (ValueConst Integer String))
-> ValueConst Integer String -> f (ValueConst Integer String)
forall a b. (a -> b) -> a -> b
$ String -> ValueConst Integer String
forall nat symbol. symbol -> ValueConst nat symbol
VCString (String -> ValueConst Integer String)
-> String -> ValueConst Integer String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
fromGQLValueConst (GQL.VCBoolean b :: Bool
b)
= ValueConst Integer String -> f (ValueConst Integer String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueConst Integer String -> f (ValueConst Integer String))
-> ValueConst Integer String -> f (ValueConst Integer String)
forall a b. (a -> b) -> a -> b
$ Bool -> ValueConst Integer String
forall nat symbol. Bool -> ValueConst nat symbol
VCBoolean Bool
b
fromGQLValueConst GQL.VCNull
= ValueConst Integer String -> f (ValueConst Integer String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueConst Integer String
forall nat symbol. ValueConst nat symbol
VCNull
fromGQLValueConst (GQL.VCEnum (EnumValue -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
s))
= ValueConst Integer String -> f (ValueConst Integer String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueConst Integer String -> f (ValueConst Integer String))
-> ValueConst Integer String -> f (ValueConst Integer String)
forall a b. (a -> b) -> a -> b
$ String -> ValueConst Integer String
forall nat symbol. symbol -> ValueConst nat symbol
VCEnum (String -> ValueConst Integer String)
-> String -> ValueConst Integer String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
fromGQLValueConst (GQL.VCList (ListValueC -> [ValueConst]
forall a b. Coercible a b => a -> b
coerce -> [ValueConst]
xs))
= [ValueConst Integer String] -> ValueConst Integer String
forall nat symbol. [ValueConst nat symbol] -> ValueConst nat symbol
VCList ([ValueConst Integer String] -> ValueConst Integer String)
-> f [ValueConst Integer String] -> f (ValueConst Integer String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValueConst -> f (ValueConst Integer String))
-> [ValueConst] -> f [ValueConst Integer String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ValueConst -> f (ValueConst Integer String)
forall (f :: * -> *).
Alternative f =>
ValueConst -> f (ValueConst Integer String)
fromGQLValueConst [ValueConst]
xs
fromGQLValueConst (GQL.VCObject (ObjectValueC -> [ObjectFieldG ValueConst]
forall a b. Coercible a b => a -> b
coerce -> [ObjectFieldG ValueConst]
o))
= [(String, ValueConst Integer String)] -> ValueConst Integer String
forall nat symbol.
[(symbol, ValueConst nat symbol)] -> ValueConst nat symbol
VCObject ([(String, ValueConst Integer String)]
-> ValueConst Integer String)
-> f [(String, ValueConst Integer String)]
-> f (ValueConst Integer String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectFieldG ValueConst -> f (String, ValueConst Integer String))
-> [ObjectFieldG ValueConst]
-> f [(String, ValueConst Integer String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ObjectFieldG ValueConst -> f (String, ValueConst Integer String)
fromGQLField [ObjectFieldG ValueConst]
o
where fromGQLField :: GQL.ObjectFieldG GQL.ValueConst
-> f (String, ValueConst Integer String)
fromGQLField :: ObjectFieldG ValueConst -> f (String, ValueConst Integer String)
fromGQLField (GQL.ObjectFieldG (Name -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
n) v :: ValueConst
v)
= (Text -> String
T.unpack Text
n,) (ValueConst Integer String -> (String, ValueConst Integer String))
-> f (ValueConst Integer String)
-> f (String, ValueConst Integer String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueConst -> f (ValueConst Integer String)
forall (f :: * -> *).
Alternative f =>
ValueConst -> f (ValueConst Integer String)
fromGQLValueConst ValueConst
v
fromGQLValueConst _ = f (ValueConst Integer String)
forall (f :: * -> *) a. Alternative f => f a
empty
class ReflectValueConst (v :: ValueConst nat symbol) where
reflectValueConst :: proxy v -> GQL.ValueConst
instance KnownNat n => ReflectValueConst ('VCInt n) where
reflectValueConst :: proxy ('VCInt n) -> ValueConst
reflectValueConst _ = Int32 -> ValueConst
GQL.VCInt (Int32 -> ValueConst) -> Int32 -> ValueConst
forall a b. (a -> b) -> a -> b
$ Integer -> Int32
forall a. Num a => Integer -> a
fromInteger (Integer -> Int32) -> Integer -> Int32
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n)
instance KnownSymbol s => ReflectValueConst ('VCString s) where
reflectValueConst :: proxy ('VCString s) -> ValueConst
reflectValueConst _ = StringValue -> ValueConst
GQL.VCString (StringValue -> ValueConst) -> StringValue -> ValueConst
forall a b. (a -> b) -> a -> b
$ Text -> StringValue
forall a b. Coercible a b => a -> b
coerce (Text -> StringValue) -> Text -> StringValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
instance ReflectValueConst ('VCBoolean 'True) where
reflectValueConst :: proxy ('VCBoolean 'True) -> ValueConst
reflectValueConst _ = Bool -> ValueConst
GQL.VCBoolean Bool
True
instance ReflectValueConst ('VCBoolean 'False) where
reflectValueConst :: proxy ('VCBoolean 'False) -> ValueConst
reflectValueConst _ = Bool -> ValueConst
GQL.VCBoolean Bool
False
instance ReflectValueConst 'VCNull where
reflectValueConst :: proxy 'VCNull -> ValueConst
reflectValueConst _ = ValueConst
GQL.VCNull
instance KnownSymbol e => ReflectValueConst ('VCEnum e) where
reflectValueConst :: proxy ('VCEnum e) -> ValueConst
reflectValueConst _ = StringValue -> ValueConst
GQL.VCString (StringValue -> ValueConst) -> StringValue -> ValueConst
forall a b. (a -> b) -> a -> b
$ Text -> StringValue
forall a b. Coercible a b => a -> b
coerce (Text -> StringValue) -> Text -> StringValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy e -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy e
forall k (t :: k). Proxy t
Proxy @e)
instance ReflectValueConstList xs => ReflectValueConst ('VCList xs) where
reflectValueConst :: proxy ('VCList xs) -> ValueConst
reflectValueConst _ = ListValueC -> ValueConst
GQL.VCList (ListValueC -> ValueConst) -> ListValueC -> ValueConst
forall a b. (a -> b) -> a -> b
$ [ValueConst] -> ListValueC
forall a b. Coercible a b => a -> b
coerce ([ValueConst] -> ListValueC) -> [ValueConst] -> ListValueC
forall a b. (a -> b) -> a -> b
$ Proxy xs -> [ValueConst]
forall k (xs :: k) (proxy :: k -> *).
ReflectValueConstList xs =>
proxy xs -> [ValueConst]
reflectValueConstList (Proxy xs
forall k (t :: k). Proxy t
Proxy @xs)
instance ReflectValueConstObject xs => ReflectValueConst ('VCObject xs) where
reflectValueConst :: proxy ('VCObject xs) -> ValueConst
reflectValueConst _ = ObjectValueC -> ValueConst
GQL.VCObject (ObjectValueC -> ValueConst) -> ObjectValueC -> ValueConst
forall a b. (a -> b) -> a -> b
$ [ObjectFieldG ValueConst] -> ObjectValueC
forall a b. Coercible a b => a -> b
coerce ([ObjectFieldG ValueConst] -> ObjectValueC)
-> [ObjectFieldG ValueConst] -> ObjectValueC
forall a b. (a -> b) -> a -> b
$ Proxy xs -> [ObjectFieldG ValueConst]
forall k (xs :: k) (proxy :: k -> *).
ReflectValueConstObject xs =>
proxy xs -> [ObjectFieldG ValueConst]
reflectValueConstObject (Proxy xs
forall k (t :: k). Proxy t
Proxy @xs)
class ReflectValueConstList xs where
reflectValueConstList :: proxy xs -> [GQL.ValueConst]
instance ReflectValueConstList '[] where
reflectValueConstList :: proxy '[] -> [ValueConst]
reflectValueConstList _ = []
instance (ReflectValueConst x, ReflectValueConstList xs)
=> ReflectValueConstList (x ': xs) where
reflectValueConstList :: proxy (x : xs) -> [ValueConst]
reflectValueConstList _
= Proxy x -> ValueConst
forall nat symbol (v :: ValueConst nat symbol)
(proxy :: ValueConst nat symbol -> *).
ReflectValueConst v =>
proxy v -> ValueConst
reflectValueConst (Proxy x
forall k (t :: k). Proxy t
Proxy @x) ValueConst -> [ValueConst] -> [ValueConst]
forall a. a -> [a] -> [a]
: Proxy xs -> [ValueConst]
forall k (xs :: k) (proxy :: k -> *).
ReflectValueConstList xs =>
proxy xs -> [ValueConst]
reflectValueConstList (Proxy xs
forall k (t :: k). Proxy t
Proxy @xs)
class ReflectValueConstObject xs where
reflectValueConstObject :: proxy xs -> [GQL.ObjectFieldG GQL.ValueConst]
instance ReflectValueConstObject '[] where
reflectValueConstObject :: proxy '[] -> [ObjectFieldG ValueConst]
reflectValueConstObject _ = []
instance (KnownSymbol a, ReflectValueConst x, ReflectValueConstObject xs)
=> ReflectValueConstObject ( '(a, x) ': xs) where
reflectValueConstObject :: proxy ('(a, x) : xs) -> [ObjectFieldG ValueConst]
reflectValueConstObject _
= Name -> ValueConst -> ObjectFieldG ValueConst
forall a. Name -> a -> ObjectFieldG a
GQL.ObjectFieldG (Text -> Name
forall a b. Coercible a b => a -> b
coerce (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy a
forall k (t :: k). Proxy t
Proxy @a)) (Proxy x -> ValueConst
forall nat symbol (v :: ValueConst nat symbol)
(proxy :: ValueConst nat symbol -> *).
ReflectValueConst v =>
proxy v -> ValueConst
reflectValueConst (Proxy x
forall k (t :: k). Proxy t
Proxy @x))
ObjectFieldG ValueConst
-> [ObjectFieldG ValueConst] -> [ObjectFieldG ValueConst]
forall a. a -> [a] -> [a]
: Proxy xs -> [ObjectFieldG ValueConst]
forall k (xs :: k) (proxy :: k -> *).
ReflectValueConstObject xs =>
proxy xs -> [ObjectFieldG ValueConst]
reflectValueConstObject (Proxy xs
forall k (t :: k). Proxy t
Proxy @xs)