{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Kinded.Type
  ( DeriveKindedType (..),
    DERIVE_TYPE,
    deriveInterfaceDefinition,
    deriveScalarDefinition,
    deriveTypeGuardUnions,
  )
where

import Data.Morpheus.Server.Deriving.Internal.Schema.Type
  ( deriveInterfaceDefinition,
    deriveScalarDefinition,
    deriveTypeDefinition,
    deriveTypeGuardUnions,
  )
import Data.Morpheus.Server.Deriving.Utils.GRep
  ( GRep,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded
  ( CatType,
    catMap,
    unliftKind,
  )
import Data.Morpheus.Server.Deriving.Utils.Use
  ( UseDeriving (..),
    UseGQLType (..),
  )
import Data.Morpheus.Server.Types.Kind
  ( DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Server.Types.SchemaT
  ( SchemaT,
  )
import Data.Morpheus.Types.GQLScalar
  ( DecodeScalar (..),
    scalarValidator,
  )
import Data.Morpheus.Types.Internal.AST
  ( ArgumentsDefinition,
    CONST,
    TypeCategory,
    TypeDefinition (..),
  )
import GHC.Generics
import Relude

type DERIVE_TYPE gql c a = (gql a, GRep gql gql (SchemaT c (Maybe (ArgumentsDefinition CONST))) (Rep a))

-- | DeriveType With specific Kind: 'kind': object, scalar, enum ...
class DeriveKindedType gql val (cat :: TypeCategory) (kind :: DerivingKind) a where
  deriveKindedType :: UseDeriving gql val -> CatType cat (f kind a) -> SchemaT cat (TypeDefinition cat CONST)

instance (gql a) => DeriveKindedType gql val cat WRAPPER (f a) where
  deriveKindedType :: forall {k} (f :: DerivingKind -> k -> k).
UseDeriving gql val
-> CatType cat (f WRAPPER (f a))
-> SchemaT cat (TypeDefinition cat CONST)
deriveKindedType UseDeriving {UseValue val
UseGQLType gql
forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
dirGQL :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirArgs :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseValue val
__directives :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
dirGQL :: UseGQLType gql
dirArgs :: UseValue val
__directives :: forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
..} = forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> SchemaT c (TypeDefinition c CONST)
useDeriveType UseGQLType gql
dirGQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (a :: k1) (cat :: TypeCategory)
       (b :: k2).
f a -> CatType cat b -> CatType cat a
catMap (forall {k} (t :: k). Proxy t
Proxy @a)

instance (DecodeScalar a, gql a) => DeriveKindedType gql val cat SCALAR a where
  deriveKindedType :: forall {k} (f :: DerivingKind -> * -> k).
UseDeriving gql val
-> CatType cat (f SCALAR a)
-> SchemaT cat (TypeDefinition cat CONST)
deriveKindedType UseDeriving gql val
drv = forall (gql :: * -> Constraint) a (cat :: TypeCategory)
       (args :: * -> Constraint) (kind :: TypeCategory).
gql a =>
(CatType cat a -> ScalarDefinition)
-> UseDeriving gql args
-> CatType cat a
-> SchemaT kind (TypeDefinition cat CONST)
deriveScalarDefinition forall (f :: * -> *) a. DecodeScalar a => f a -> ScalarDefinition
scalarValidator UseDeriving gql val
drv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} {k3} (cat :: TypeCategory) (f :: k1 -> k2 -> k3)
       (k4 :: k1) (a :: k2).
CatType cat (f k4 a) -> CatType cat a
unliftKind

instance DERIVE_TYPE gql cat a => DeriveKindedType gql val cat TYPE a where
  deriveKindedType :: forall {k} (f :: DerivingKind -> * -> k).
UseDeriving gql val
-> CatType cat (f TYPE a) -> SchemaT cat (TypeDefinition cat CONST)
deriveKindedType UseDeriving gql val
drv = forall (gql :: * -> Constraint) a (c :: TypeCategory)
       (args :: * -> Constraint).
(gql a,
 GRep
   gql gql (SchemaT c (Maybe (ArgumentsDefinition CONST))) (Rep a)) =>
UseDeriving gql args
-> CatType c a -> SchemaT c (TypeDefinition c CONST)
deriveTypeDefinition UseDeriving gql val
drv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} {k3} (cat :: TypeCategory) (f :: k1 -> k2 -> k3)
       (k4 :: k1) (a :: k2).
CatType cat (f k4 a) -> CatType cat a
unliftKind