{-# language DataKinds #-}
{-# language FlexibleInstances #-}
{-# language PolyKinds #-}
{-# language ScopedTypeVariables #-}
{-# language TupleSections #-}
{-# language TypeApplications #-}
{-# language TypeOperators #-}
{-# language ViewPatterns #-}
module Mu.GraphQL.Annotations (
ValueConst(..)
, DefaultValue(..)
, ReflectValueConst(..)
, fromGQLValueConst
, module Mu.Rpc.Annotations
) 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
import Mu.Rpc.Annotations
newtype DefaultValue
= DefaultValue (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 Integer
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 (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
fromGQLValueConst (GQL.VCString (StringValue -> Text
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 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 ValueConst
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
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]
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]
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
coerce -> Text
n) 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 ValueConst
_ = 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 proxy ('VCInt n)
_ = Integer -> ValueConst
GQL.VCInt (Integer -> ValueConst) -> Integer -> ValueConst
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer) -> Integer -> Integer
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 proxy ('VCString s)
_ = StringValue -> ValueConst
GQL.VCString (StringValue -> ValueConst) -> StringValue -> ValueConst
forall a b. (a -> b) -> a -> b
$ Text -> StringValue
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 proxy ('VCBoolean 'True)
_ = Bool -> ValueConst
GQL.VCBoolean Bool
True
instance ReflectValueConst ('VCBoolean 'False) where
reflectValueConst :: proxy ('VCBoolean 'False) -> ValueConst
reflectValueConst proxy ('VCBoolean 'False)
_ = Bool -> ValueConst
GQL.VCBoolean Bool
False
instance ReflectValueConst 'VCNull where
reflectValueConst :: proxy 'VCNull -> ValueConst
reflectValueConst proxy 'VCNull
_ = ValueConst
GQL.VCNull
instance KnownSymbol e => ReflectValueConst ('VCEnum e) where
reflectValueConst :: proxy ('VCEnum e) -> ValueConst
reflectValueConst proxy ('VCEnum e)
_ = StringValue -> ValueConst
GQL.VCString (StringValue -> ValueConst) -> StringValue -> ValueConst
forall a b. (a -> b) -> a -> b
$ Text -> StringValue
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 proxy ('VCList xs)
_ = ListValueC -> ValueConst
GQL.VCList (ListValueC -> ValueConst) -> ListValueC -> ValueConst
forall a b. (a -> b) -> a -> b
$ [ValueConst] -> ListValueC
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 proxy ('VCObject xs)
_ = ObjectValueC -> ValueConst
GQL.VCObject (ObjectValueC -> ValueConst) -> ObjectValueC -> ValueConst
forall a b. (a -> b) -> a -> b
$ [ObjectFieldG ValueConst] -> ObjectValueC
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 proxy '[]
_ = []
instance (ReflectValueConst x, ReflectValueConstList xs)
=> ReflectValueConstList (x ': xs) where
reflectValueConstList :: proxy (x : xs) -> [ValueConst]
reflectValueConstList proxy (x : xs)
_
= 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 proxy '[]
_ = []
instance (KnownSymbol a, ReflectValueConst x, ReflectValueConstObject xs)
=> ReflectValueConstObject ( '(a, x) ': xs) where
reflectValueConstObject :: proxy ('(a, x) : xs) -> [ObjectFieldG ValueConst]
reflectValueConstObject proxy ('(a, x) : xs)
_
= Name -> ValueConst -> ObjectFieldG ValueConst
forall a. Name -> a -> ObjectFieldG a
GQL.ObjectFieldG (Text -> Name
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)