{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Types.GQLType
( GQLType (..),
GQLTypeOptions (..),
defaultTypeOptions,
TypeData (..),
)
where
import Data.Map (Map)
import Data.Morpheus.Kind
import Data.Morpheus.Server.Types.SchemaT
( SchemaT,
TypeFingerprint (..),
)
import Data.Morpheus.Server.Types.Types
( MapKind,
Pair,
Undefined (..),
)
import Data.Morpheus.Types.ID (ID)
import Data.Morpheus.Types.Internal.AST
( ArgumentsDefinition,
CONST,
Description,
Directives,
FieldName,
QUERY,
TypeName (..),
TypeWrapper (..),
Value,
toNullable,
)
import Data.Morpheus.Types.Internal.Resolving
( Resolver,
SubscriptionField,
)
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import Data.Text
( Text,
intercalate,
pack,
)
import Data.Typeable
( TyCon,
TypeRep,
Typeable,
splitTyConApp,
tyConFingerprint,
tyConName,
typeRep,
typeRepTyCon,
)
import Prelude
( ($),
(.),
Bool (..),
Eq (..),
Float,
Int,
Maybe (..),
String,
concatMap,
fmap,
id,
mempty,
)
data TypeData = TypeData
{ TypeData -> TypeName
gqlTypeName :: TypeName,
TypeData -> [TypeWrapper]
gqlWrappers :: [TypeWrapper],
TypeData -> TypeFingerprint
gqlFingerprint :: TypeFingerprint
}
data GQLTypeOptions = GQLTypeOptions
{ GQLTypeOptions -> String -> String
fieldLabelModifier :: String -> String,
GQLTypeOptions -> String -> String
constructorTagModifier :: String -> String
}
defaultTypeOptions :: GQLTypeOptions
defaultTypeOptions :: GQLTypeOptions
defaultTypeOptions =
GQLTypeOptions :: (String -> String) -> (String -> String) -> GQLTypeOptions
GQLTypeOptions
{ fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
forall a. a -> a
id,
constructorTagModifier :: String -> String
constructorTagModifier = String -> String
forall a. a -> a
id
}
getTypename :: Typeable a => f a -> TypeName
getTypename :: f a -> TypeName
getTypename = Text -> TypeName
TypeName (Text -> TypeName) -> (f a -> Text) -> f a -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
intercalate Text
"_" ([Text] -> Text) -> (f a -> [Text]) -> f a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [Text]
forall (proxy :: * -> *). proxy a -> [Text]
getName
where
getName :: proxy a -> [Text]
getName = ([TyCon] -> [Text]) -> (proxy a -> [TyCon]) -> proxy a -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TyCon -> Text) -> [TyCon] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
pack (String -> Text) -> (TyCon -> String) -> TyCon -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> String
tyConName)) ((TyCon -> TyCon) -> [TyCon] -> [TyCon]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyCon -> TyCon
replacePairCon ([TyCon] -> [TyCon]) -> (proxy a -> [TyCon]) -> proxy a -> [TyCon]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TyCon, [TypeRep]) -> [TyCon]
ignoreResolver ((TyCon, [TypeRep]) -> [TyCon])
-> (proxy a -> (TyCon, [TypeRep])) -> proxy a -> [TyCon]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> (TyCon, [TypeRep])
splitTyConApp (TypeRep -> (TyCon, [TypeRep]))
-> (proxy a -> TypeRep) -> proxy a -> (TyCon, [TypeRep])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep)
getFingerprint :: Typeable a => f a -> TypeFingerprint
getFingerprint :: f a -> TypeFingerprint
getFingerprint = [Fingerprint] -> TypeFingerprint
TypeableFingerprint ([Fingerprint] -> TypeFingerprint)
-> (f a -> [Fingerprint]) -> f a -> TypeFingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [Fingerprint]
forall (proxy :: * -> *). proxy a -> [Fingerprint]
conFingerprints
where
conFingerprints :: proxy a -> [Fingerprint]
conFingerprints = ([TyCon] -> [Fingerprint])
-> (proxy a -> [TyCon]) -> proxy a -> [Fingerprint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TyCon -> Fingerprint) -> [TyCon] -> [Fingerprint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyCon -> Fingerprint
tyConFingerprint) ((TyCon, [TypeRep]) -> [TyCon]
ignoreResolver ((TyCon, [TypeRep]) -> [TyCon])
-> (proxy a -> (TyCon, [TypeRep])) -> proxy a -> [TyCon]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> (TyCon, [TypeRep])
splitTyConApp (TypeRep -> (TyCon, [TypeRep]))
-> (proxy a -> TypeRep) -> proxy a -> (TyCon, [TypeRep])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep)
deriveTypeData :: Typeable a => f a -> TypeData
deriveTypeData :: f a -> TypeData
deriveTypeData f a
proxy =
TypeData :: TypeName -> [TypeWrapper] -> TypeFingerprint -> TypeData
TypeData
{ gqlTypeName :: TypeName
gqlTypeName = f a -> TypeName
forall a (f :: * -> *). Typeable a => f a -> TypeName
getTypename f a
proxy,
gqlWrappers :: [TypeWrapper]
gqlWrappers = [],
gqlFingerprint :: TypeFingerprint
gqlFingerprint = f a -> TypeFingerprint
forall a (f :: * -> *). Typeable a => f a -> TypeFingerprint
getFingerprint f a
proxy
}
mkTypeData :: TypeName -> TypeData
mkTypeData :: TypeName -> TypeData
mkTypeData TypeName
name =
TypeData :: TypeName -> [TypeWrapper] -> TypeFingerprint -> TypeData
TypeData
{ gqlTypeName :: TypeName
gqlTypeName = TypeName
name,
gqlFingerprint :: TypeFingerprint
gqlFingerprint = TypeName -> TypeFingerprint
InternalFingerprint TypeName
name,
gqlWrappers :: [TypeWrapper]
gqlWrappers = []
}
list :: [TypeWrapper] -> [TypeWrapper]
list :: [TypeWrapper] -> [TypeWrapper]
list = (TypeWrapper
TypeList TypeWrapper -> [TypeWrapper] -> [TypeWrapper]
forall a. a -> [a] -> [a]
:)
wrapper :: ([TypeWrapper] -> [TypeWrapper]) -> TypeData -> TypeData
wrapper :: ([TypeWrapper] -> [TypeWrapper]) -> TypeData -> TypeData
wrapper [TypeWrapper] -> [TypeWrapper]
f TypeData {[TypeWrapper]
TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlWrappers :: [TypeWrapper]
gqlTypeName :: TypeName
gqlFingerprint :: TypeData -> TypeFingerprint
gqlWrappers :: TypeData -> [TypeWrapper]
gqlTypeName :: TypeData -> TypeName
..} = TypeData :: TypeName -> [TypeWrapper] -> TypeFingerprint -> TypeData
TypeData {gqlWrappers :: [TypeWrapper]
gqlWrappers = [TypeWrapper] -> [TypeWrapper]
f [TypeWrapper]
gqlWrappers, TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlTypeName :: TypeName
gqlFingerprint :: TypeFingerprint
gqlTypeName :: TypeName
..}
resolverCon :: TyCon
resolverCon :: TyCon
resolverCon = TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> TypeRep -> TyCon
forall a b. (a -> b) -> a -> b
$ Proxy (Resolver QUERY () Maybe) -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy (Resolver QUERY () Maybe) -> TypeRep)
-> Proxy (Resolver QUERY () Maybe) -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy (Resolver QUERY () Maybe)
forall k (t :: k). Proxy t
Proxy @(Resolver QUERY () Maybe)
replacePairCon :: TyCon -> TyCon
replacePairCon :: TyCon -> TyCon
replacePairCon TyCon
x | TyCon
hsPair TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
x = TyCon
gqlPair
where
hsPair :: TyCon
hsPair = TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> TypeRep -> TyCon
forall a b. (a -> b) -> a -> b
$ Proxy (Int, Int) -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy (Int, Int) -> TypeRep) -> Proxy (Int, Int) -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy (Int, Int)
forall k (t :: k). Proxy t
Proxy @(Int, Int)
gqlPair :: TyCon
gqlPair = TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> TypeRep -> TyCon
forall a b. (a -> b) -> a -> b
$ Proxy (Pair Int Int) -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy (Pair Int Int) -> TypeRep)
-> Proxy (Pair Int Int) -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy (Pair Int Int)
forall k (t :: k). Proxy t
Proxy @(Pair Int Int)
replacePairCon TyCon
x = TyCon
x
ignoreResolver :: (TyCon, [TypeRep]) -> [TyCon]
ignoreResolver :: (TyCon, [TypeRep]) -> [TyCon]
ignoreResolver (TyCon
con, [TypeRep]
_) | TyCon
con TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
resolverCon = []
ignoreResolver (TyCon
con, [TypeRep]
args) =
TyCon
con TyCon -> [TyCon] -> [TyCon]
forall a. a -> [a] -> [a]
: (TypeRep -> [TyCon]) -> [TypeRep] -> [TyCon]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((TyCon, [TypeRep]) -> [TyCon]
ignoreResolver ((TyCon, [TypeRep]) -> [TyCon])
-> (TypeRep -> (TyCon, [TypeRep])) -> TypeRep -> [TyCon]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> (TyCon, [TypeRep])
splitTyConApp) [TypeRep]
args
class ToValue (KIND a) => GQLType a where
type KIND a :: GQL_KIND
type KIND a = OUTPUT
implements :: f a -> [SchemaT TypeName]
implements f a
_ = []
isObjectKind :: f a -> Bool
isObjectKind f a
_ = GQL_KIND -> Bool
isObject (GQL_KIND -> Bool) -> GQL_KIND -> Bool
forall a b. (a -> b) -> a -> b
$ Proxy (KIND a) -> GQL_KIND
forall (a :: GQL_KIND) (f :: GQL_KIND -> *).
ToValue a =>
f a -> GQL_KIND
toValue (Proxy (KIND a)
forall k (t :: k). Proxy t
Proxy @(KIND a))
description :: f a -> Maybe Text
description f a
_ = Maybe Text
forall a. Maybe a
Nothing
getDescriptions :: f a -> Map Text Description
getDescriptions f a
_ = Map Text Text
forall a. Monoid a => a
mempty
typeOptions :: f a -> GQLTypeOptions
typeOptions f a
_ = GQLTypeOptions
defaultTypeOptions
getDirectives :: f a -> Map Text (Directives CONST)
getDirectives f a
_ = Map Text (Directives CONST)
forall a. Monoid a => a
mempty
getFieldContents ::
f a ->
Map
FieldName
( Maybe (Value CONST),
Maybe (ArgumentsDefinition CONST)
)
getFieldContents f a
_ = Map
FieldName (Maybe (Value CONST), Maybe (ArgumentsDefinition CONST))
forall a. Monoid a => a
mempty
isEmptyType :: f a -> Bool
isEmptyType f a
_ = Bool
False
__type :: f a -> TypeData
default __type :: Typeable a => f a -> TypeData
__type f a
_ = Proxy a -> TypeData
forall a (f :: * -> *). Typeable a => f a -> TypeData
deriveTypeData (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
instance GQLType Int where
type KIND Int = SCALAR
__type :: f Int -> TypeData
__type f Int
_ = TypeName -> TypeData
mkTypeData TypeName
"Int"
instance GQLType Float where
type KIND Float = SCALAR
__type :: f Float -> TypeData
__type f Float
_ = TypeName -> TypeData
mkTypeData TypeName
"Float"
instance GQLType Text where
type KIND Text = SCALAR
__type :: f Text -> TypeData
__type f Text
_ = TypeName -> TypeData
mkTypeData TypeName
"String"
instance GQLType Bool where
type KIND Bool = SCALAR
__type :: f Bool -> TypeData
__type f Bool
_ = TypeName -> TypeData
mkTypeData TypeName
"Boolean"
instance GQLType ID where
type KIND ID = SCALAR
__type :: f ID -> TypeData
__type f ID
_ = TypeName -> TypeData
mkTypeData TypeName
"ID"
instance GQLType ()
instance Typeable m => GQLType (Undefined m) where
type KIND (Undefined m) = WRAPPER
isEmptyType :: f (Undefined m) -> Bool
isEmptyType f (Undefined m)
_ = Bool
True
instance GQLType a => GQLType (Maybe a) where
type KIND (Maybe a) = WRAPPER
__type :: f (Maybe a) -> TypeData
__type f (Maybe a)
_ = ([TypeWrapper] -> [TypeWrapper]) -> TypeData -> TypeData
wrapper [TypeWrapper] -> [TypeWrapper]
forall a. Nullable a => a -> a
toNullable (TypeData -> TypeData) -> TypeData -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeData
forall a (f :: * -> *). GQLType a => f a -> TypeData
__type (Proxy a -> TypeData) -> Proxy a -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a
instance GQLType a => GQLType [a] where
type KIND [a] = WRAPPER
__type :: f [a] -> TypeData
__type f [a]
_ = ([TypeWrapper] -> [TypeWrapper]) -> TypeData -> TypeData
wrapper [TypeWrapper] -> [TypeWrapper]
list (TypeData -> TypeData) -> TypeData -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeData
forall a (f :: * -> *). GQLType a => f a -> TypeData
__type (Proxy a -> TypeData) -> Proxy a -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a
instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (a, b) where
type KIND (a, b) = WRAPPER
__type :: f (a, b) -> TypeData
__type f (a, b)
_ = Proxy (Pair a b) -> TypeData
forall a (f :: * -> *). GQLType a => f a -> TypeData
__type (Proxy (Pair a b) -> TypeData) -> Proxy (Pair a b) -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy (Pair a b)
forall k (t :: k). Proxy t
Proxy @(Pair a b)
instance GQLType a => GQLType (Set a) where
type KIND (Set a) = WRAPPER
__type :: f (Set a) -> TypeData
__type f (Set a)
_ = Proxy [a] -> TypeData
forall a (f :: * -> *). GQLType a => f a -> TypeData
__type (Proxy [a] -> TypeData) -> Proxy [a] -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy [a]
forall k (t :: k). Proxy t
Proxy @[a]
instance (Typeable k, Typeable v) => GQLType (Map k v) where
type KIND (Map k v) = WRAPPER
instance GQLType a => GQLType (Resolver o e m a) where
type KIND (Resolver o e m a) = WRAPPER
__type :: f (Resolver o e m a) -> TypeData
__type f (Resolver o e m a)
_ = Proxy a -> TypeData
forall a (f :: * -> *). GQLType a => f a -> TypeData
__type (Proxy a -> TypeData) -> Proxy a -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a
instance GQLType a => GQLType (SubscriptionField a) where
type KIND (SubscriptionField a) = WRAPPER
__type :: f (SubscriptionField a) -> TypeData
__type f (SubscriptionField a)
_ = Proxy a -> TypeData
forall a (f :: * -> *). GQLType a => f a -> TypeData
__type (Proxy a -> TypeData) -> Proxy a -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a
instance GQLType b => GQLType (a -> b) where
type KIND (a -> b) = WRAPPER
__type :: f (a -> b) -> TypeData
__type f (a -> b)
_ = Proxy b -> TypeData
forall a (f :: * -> *). GQLType a => f a -> TypeData
__type (Proxy b -> TypeData) -> Proxy b -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy b
forall k (t :: k). Proxy t
Proxy @b
instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (Pair a b)
instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (MapKind a b m) where
__type :: f (MapKind a b m) -> TypeData
__type f (MapKind a b m)
_ = Proxy (Map a b) -> TypeData
forall a (f :: * -> *). GQLType a => f a -> TypeData
__type (Proxy (Map a b) -> TypeData) -> Proxy (Map a b) -> TypeData
forall a b. (a -> b) -> a -> b
$ Proxy (Map a b)
forall k (t :: k). Proxy t
Proxy @(Map a b)