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

module Data.Morpheus.Server.Deriving.Utils.Kinded
  ( CatType (..),
    inputType,
    outputType,
    unliftKind,
    mapCat,
    mkScalar,
    isIN,
    Kinded (..),
    mkEnum,
    mkObject,
  )
where

import Data.Morpheus.Server.Types.Kind (DerivingKind)
import Data.Morpheus.Types.Internal.AST
  ( DataEnumValue,
    FieldDefinition,
    IN,
    OUT,
    ScalarDefinition,
    TRUE,
    TypeCategory (..),
    TypeContent (..),
    unsafeFromFields,
  )
import Prelude

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

deriving instance Show (CatType cat a)

inputType :: f a -> CatType IN a
inputType :: forall {k} (f :: k -> *) (a :: k). f a -> CatType 'IN a
inputType f a
_ = CatType 'IN a
forall {k} (a :: k). CatType 'IN a
InputType

outputType :: f a -> CatType OUT a
outputType :: forall {k} (f :: k -> *) (a :: k). f a -> CatType 'OUT a
outputType f a
_ = CatType 'OUT a
forall {k} (a :: k). CatType 'OUT a
OutputType

unliftKind :: CatType cat (f k a) -> CatType cat a
unliftKind :: forall {k} {k} {k} (cat :: TypeCategory) (f :: k -> k -> k)
       (k :: k) (a :: k).
CatType cat (f k a) -> CatType cat a
unliftKind CatType cat (f k a)
InputType = CatType cat a
CatType 'IN a
forall {k} (a :: k). CatType 'IN a
InputType
unliftKind CatType cat (f k a)
OutputType = CatType cat a
CatType 'OUT a
forall {k} (a :: k). CatType 'OUT a
OutputType

mapCat :: f a -> CatType cat b -> CatType cat a
mapCat :: forall {k} {k} (f :: k -> *) (a :: k) (cat :: TypeCategory)
       (b :: k).
f a -> CatType cat b -> CatType cat a
mapCat f a
_ CatType cat b
InputType = CatType cat a
CatType 'IN a
forall {k} (a :: k). CatType 'IN a
InputType
mapCat f a
_ CatType cat b
OutputType = CatType cat a
CatType 'OUT a
forall {k} (a :: k). CatType 'OUT a
OutputType

mkScalar :: CatType c a -> ScalarDefinition -> TypeContent TRUE c s
mkScalar :: forall {k} (c :: TypeCategory) (a :: k) (s :: Stage).
CatType c a -> ScalarDefinition -> TypeContent TRUE c s
mkScalar CatType c a
InputType ScalarDefinition
f = ScalarDefinition -> TypeContent (LEAF <=? c) c s
forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> TypeContent (LEAF <=? a) a s
DataScalar ScalarDefinition
f
mkScalar CatType c a
OutputType ScalarDefinition
f = ScalarDefinition -> TypeContent (LEAF <=? c) c s
forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> TypeContent (LEAF <=? a) a s
DataScalar ScalarDefinition
f

mkEnum :: CatType c a -> [DataEnumValue s] -> TypeContent TRUE c s
mkEnum :: forall {k} (c :: TypeCategory) (a :: k) (s :: Stage).
CatType c a -> [DataEnumValue s] -> TypeContent TRUE c s
mkEnum CatType c a
InputType [DataEnumValue s]
x = [DataEnumValue s] -> TypeContent (LEAF <=? c) c s
forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> TypeContent (LEAF <=? a) a s
DataEnum [DataEnumValue s]
x
mkEnum CatType c a
OutputType [DataEnumValue s]
x = [DataEnumValue s] -> TypeContent (LEAF <=? c) c s
forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> TypeContent (LEAF <=? a) a s
DataEnum [DataEnumValue s]
x

mkObject :: CatType kind a -> [FieldDefinition kind s] -> TypeContent TRUE kind s
mkObject :: forall {k} (kind :: TypeCategory) (a :: k) (s :: Stage).
CatType kind a
-> [FieldDefinition kind s] -> TypeContent TRUE kind s
mkObject CatType kind a
InputType = FieldsDefinition 'IN s -> TypeContent TRUE kind s
FieldsDefinition 'IN s
-> TypeContent (INPUT_OBJECT <=? kind) kind s
forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition 'IN s -> TypeContent (INPUT_OBJECT <=? a) a s
DataInputObject (FieldsDefinition 'IN s -> TypeContent TRUE kind s)
-> ([FieldDefinition kind s] -> FieldsDefinition 'IN s)
-> [FieldDefinition kind s]
-> TypeContent TRUE kind s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDefinition kind s] -> FieldsDefinition kind s
[FieldDefinition kind s] -> FieldsDefinition 'IN s
forall (cat :: TypeCategory) (s :: Stage).
[FieldDefinition cat s] -> FieldsDefinition cat s
unsafeFromFields
mkObject CatType kind a
OutputType = [TypeName]
-> FieldsDefinition 'OUT s -> TypeContent (OBJECT <=? kind) kind s
forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition 'OUT s -> TypeContent (OBJECT <=? a) a s
DataObject [] (FieldsDefinition 'OUT s -> TypeContent TRUE kind s)
-> ([FieldDefinition kind s] -> FieldsDefinition 'OUT s)
-> [FieldDefinition kind s]
-> TypeContent TRUE kind s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldDefinition kind s] -> FieldsDefinition kind s
[FieldDefinition kind s] -> FieldsDefinition 'OUT s
forall (cat :: TypeCategory) (s :: Stage).
[FieldDefinition cat s] -> FieldsDefinition cat s
unsafeFromFields

isIN :: CatType c a -> Bool
isIN :: forall {k} (c :: TypeCategory) (a :: k). CatType c a -> Bool
isIN CatType c a
InputType = Bool
True
isIN CatType c a
_ = Bool
False

newtype Kinded (kind :: DerivingKind) a = Kinded {forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind :: a}