GQLKind.hs

{-# LANGUAGE DefaultSignatures    #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.Morpheus.Kind.GQLKind
  ( GQLKind(..)
  , scalarTypeOf
  , asObjectType
  , enumTypeOf
  , inputObjectOf
  , introspectScalar
  ) where

import           Data.Morpheus.Generics.TypeRep         (resolveTypes)
import           Data.Morpheus.Generics.Utils           (typeOf)
import           Data.Morpheus.Schema.Directive         (Directive)
import           Data.Morpheus.Schema.DirectiveLocation (DirectiveLocation)
import           Data.Morpheus.Schema.EnumValue         (EnumValue)
import           Data.Morpheus.Schema.Internal.Types    (Core (..), GObject (..), InputField, Leaf (..), LibType (..),
                                                         ObjectField (..), TypeLib, defineType, isTypeDefined)
import           Data.Morpheus.Schema.Schema            (Schema)
import           Data.Morpheus.Schema.TypeKind          (TypeKind (..))
import           Data.Morpheus.Schema.Utils.Utils       (Field, InputValue, Type)
import           Data.Proxy                             (Proxy (..))
import           Data.Text                              (Text)
import           Data.Typeable                          (Typeable)

scalarTypeOf :: GQLKind a => Proxy a -> LibType
scalarTypeOf = Leaf . LScalar . buildType

enumTypeOf :: GQLKind a => [Text] -> Proxy a -> LibType
enumTypeOf tags = Leaf . LEnum tags . buildType

asObjectType :: GQLKind a => [(Text, ObjectField)] -> Proxy a -> LibType
asObjectType fields = OutputObject . GObject fields . buildType

inputObjectOf :: GQLKind a => [(Text, InputField)] -> Proxy a -> LibType
inputObjectOf inputFields = InputObject . GObject inputFields . buildType

introspectScalar :: GQLKind a => Proxy a -> TypeLib -> TypeLib
introspectScalar = updateLib scalarTypeOf []

class GQLKind a where
  description :: Proxy a -> Text
  description _ = "default selection Description"
  typeID :: Proxy a -> Text
  default typeID :: Typeable a =>
    Proxy a -> Text
  typeID = typeOf
  buildType :: Proxy a -> Core
  buildType proxy = Core {name = typeID proxy, typeDescription = description proxy}
  updateLib :: (Proxy a -> LibType) -> [TypeLib -> TypeLib] -> Proxy a -> TypeLib -> TypeLib
  updateLib typeBuilder stack proxy lib' =
    if isTypeDefined (typeID proxy) lib'
      then lib'
      else resolveTypes lib' (defineType (typeID proxy, typeBuilder proxy) : stack)

instance GQLKind EnumValue where
  typeID _ = "__EnumValue"

instance GQLKind Type where
  typeID _ = "__Type"

instance GQLKind Field where
  typeID _ = "__Field"

instance GQLKind InputValue where
  typeID _ = "__InputValue"

instance GQLKind Schema where
  typeID _ = "__Schema"

instance GQLKind Directive where
  typeID _ = "__Directive"

instance GQLKind TypeKind where
  typeID _ = "__TypeKind"

instance GQLKind DirectiveLocation where
  typeID _ = "__DirectiveLocation"

instance GQLKind Int where
  typeID _ = "Int"

instance GQLKind Float where
  typeID _ = "Int"

instance GQLKind Text where
  typeID _ = "String"

instance GQLKind Bool where
  typeID _ = "Boolean"

instance GQLKind a => GQLKind (Maybe a) where
  typeID _ = typeID (Proxy @a)