{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | associating types to GraphQL Kinds
module Data.Morpheus.Kind
  ( SCALAR,
    OBJECT,
    ENUM,
    WRAPPER,
    UNION,
    INPUT_OBJECT,
    GQL_KIND,
    OUTPUT,
    INPUT,
    INTERFACE,
    ToValue (..),
    isObject,
  )
where

import Relude

data GQL_KIND
  = SCALAR
  | ENUM
  | INPUT
  | OUTPUT
  | WRAPPER
  | INTERFACE

class ToValue (a :: GQL_KIND) where
  toValue :: f a -> GQL_KIND

instance ToValue 'SCALAR where
  toValue :: f 'SCALAR -> GQL_KIND
toValue f 'SCALAR
_ = GQL_KIND
SCALAR

instance ToValue 'ENUM where
  toValue :: f 'ENUM -> GQL_KIND
toValue f 'ENUM
_ = GQL_KIND
ENUM

instance ToValue 'WRAPPER where
  toValue :: f 'WRAPPER -> GQL_KIND
toValue f 'WRAPPER
_ = GQL_KIND
WRAPPER

instance ToValue 'INPUT where
  toValue :: f 'INPUT -> GQL_KIND
toValue f 'INPUT
_ = GQL_KIND
INPUT

instance ToValue 'OUTPUT where
  toValue :: f 'OUTPUT -> GQL_KIND
toValue f 'OUTPUT
_ = GQL_KIND
OUTPUT

instance ToValue 'INTERFACE where
  toValue :: f 'INTERFACE -> GQL_KIND
toValue f 'INTERFACE
_ = GQL_KIND
INTERFACE

isObject :: GQL_KIND -> Bool
isObject :: GQL_KIND -> Bool
isObject GQL_KIND
INPUT = Bool
True
isObject GQL_KIND
OUTPUT = Bool
True
isObject GQL_KIND
INTERFACE = Bool
True
isObject GQL_KIND
_ = Bool
False

-- | GraphQL Scalar: Int, Float, String, Boolean or any user defined custom Scalar type
type SCALAR = 'SCALAR

-- | GraphQL Enum
type ENUM = 'ENUM

-- | GraphQL Arrays , Resolvers and NonNull fields
type WRAPPER = 'WRAPPER

-- | GraphQL Object and union
type OUTPUT = 'OUTPUT

-- | GraphQL input Object and input union
type INPUT = 'INPUT

{-# DEPRECATED INPUT_OBJECT "use more generalized kind: INPUT" #-}

-- | GraphQL input Object
type INPUT_OBJECT = 'INPUT

{-# DEPRECATED UNION "use: deriving(GQLType), IMPORTANT: only types with <type constructor name><constructor name> will sustain their form, other union constructors will be wrapped inside an new object" #-}

-- | GraphQL Union
type UNION = 'OUTPUT

{-# DEPRECATED OBJECT "use: deriving(GQLType), will be automatically inferred" #-}

-- | GraphQL Object
type OBJECT = 'OUTPUT

type INTERFACE = 'INTERFACE