{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Utils.Kinded
  ( KindedProxy (..),
    setType,
    setKind,
    kinded,
    KindedType (..),
    inputType,
    outputType,
    CategoryValue (..),
  )
where

import Data.Morpheus.Types.Internal.AST
  ( IN,
    LEAF,
    OUT,
    TypeCategory (..),
  )
import Prelude (Show)

class CategoryValue (c :: TypeCategory) where
  categoryValue :: f c -> TypeCategory

instance CategoryValue OUT where
  categoryValue :: f OUT -> TypeCategory
categoryValue f OUT
_ = TypeCategory
OUT

instance CategoryValue IN where
  categoryValue :: f IN -> TypeCategory
categoryValue f IN
_ = TypeCategory
IN

instance CategoryValue LEAF where
  categoryValue :: f LEAF -> TypeCategory
categoryValue f LEAF
_ = TypeCategory
LEAF

-- | context , like Proxy with multiple parameters
-- * 'kind': object, scalar, enum ...
-- * 'a': actual gql type
data KindedProxy k a
  = KindedProxy

setType :: f a -> kinded (k :: t) a' -> KindedProxy k a
setType :: f a -> kinded k a' -> KindedProxy k a
setType f a
_ kinded k a'
_ = KindedProxy k a
forall k k (k :: k) (a :: k). KindedProxy k a
KindedProxy

setKind :: f k -> kinded (k' :: t) a -> KindedProxy k a
setKind :: f k -> kinded k' a -> KindedProxy k a
setKind f k
_ kinded k' a
_ = KindedProxy k a
forall k k (k :: k) (a :: k). KindedProxy k a
KindedProxy

kinded :: f k -> f' a -> KindedProxy k a
kinded :: f k -> f' a -> KindedProxy k a
kinded f k
_ f' a
_ = KindedProxy k a
forall k k (k :: k) (a :: k). KindedProxy k a
KindedProxy

data KindedType (cat :: TypeCategory) a where
  InputType :: KindedType IN a
  OutputType :: KindedType OUT a

deriving instance Show (KindedType cat a)

-- converts:
--   f a -> KindedType IN a
-- or
--  f k a -> KindedType IN a
inputType :: f a -> KindedType IN a
inputType :: f a -> KindedType IN a
inputType f a
_ = KindedType IN a
forall k (a :: k). KindedType IN a
InputType

outputType :: f a -> KindedType OUT a
outputType :: f a -> KindedType OUT a
outputType f a
_ = KindedType OUT a
forall k (a :: k). KindedType OUT a
OutputType