content: {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  module Data.Morpheus.Server.Deriving.Kinded.Value
    ( KindedValue (..),
    )
  where
  
  import Control.Monad.Except (MonadError (throwError))
  import Data.Morpheus.App.Internal.Resolving
    ( ResolverState,
    )
  import Data.Morpheus.Generic
    ( GRep,
      GRepField (..),
      GRepFun (..),
      GRepValue (..),
      deriveValue,
      symbolName,
    )
  import Data.Morpheus.Internal.Ext (GQLResult, unsafeFromList)
  import Data.Morpheus.Internal.Utils
    ( IsMap (toAssoc),
      fromElems,
    )
  import Data.Morpheus.Server.Deriving.Internal.Directive
    ( visitEnumName,
      visitFieldName,
    )
  import Data.Morpheus.Server.Deriving.Internal.Value
    ( Context (..),
      DecodeRep (..),
    )
  import Data.Morpheus.Server.Deriving.Utils.Kinded
    ( CatType (..),
      Kinded (..),
      inputType,
    )
  import Data.Morpheus.Server.Deriving.Utils.Types
    ( coerceInputObject,
      coerceScalar,
      getField,
      handleEither,
    )
  import Data.Morpheus.Server.Deriving.Utils.Use
    ( UseDeriving (..),
      UseGQLType (..),
      UseGQLValue (..),
    )
  import Data.Morpheus.Server.Types.Kind
    ( CUSTOM,
      DIRECTIVE,
      DerivingKind,
      SCALAR,
      TYPE,
      WRAPPER,
    )
  import Data.Morpheus.Server.Types.Types (Arg (Arg))
  import Data.Morpheus.Types.GQLScalar
    ( DecodeScalar (..),
      EncodeScalar (..),
    )
  import Data.Morpheus.Types.GQLWrapper
    ( DecodeWrapper (..),
      DecodeWrapperConstraint,
      EncodeWrapperValue (encodeWrapperValue),
    )
  import Data.Morpheus.Types.Internal.AST
    ( CONST,
      IN,
      ObjectEntry (..),
      VALID,
      ValidValue,
      Value (..),
      internal,
    )
  import GHC.Generics
  import GHC.TypeLits (KnownSymbol)
  import Relude
  
  class KindedValue ctx (k :: DerivingKind) (a :: Type) where
    encodeKindedValue :: (UseDeriving gql args ~ ctx) => ctx -> Kinded k a -> GQLResult (Value CONST)
    decodeKindedValue :: (UseDeriving gql args ~ ctx) => ctx -> Proxy k -> ValidValue -> ResolverState a
  
  instance (EncodeScalar a, DecodeScalar a, ctx ~ UseDeriving gql args, gql a) => KindedValue ctx SCALAR a where
    encodeKindedValue _ = pure . Scalar . encodeScalar . unkind
    decodeKindedValue ctx _ = coerceScalar (useTypename ctx (InputType :: CatType IN a)) >=> handleEither . decodeScalar
  
  instance (ctx ~ UseDeriving gql args, DecodeWrapperConstraint f a, DecodeWrapper f, EncodeWrapperValue f, args a) => KindedValue ctx WRAPPER (f a) where
    encodeKindedValue ctx = encodeWrapperValue (useEncodeValue ctx) . unkind
    decodeKindedValue ctx _ value =
      runExceptT (decodeWrapper (useDecodeValue ctx) value)
        >>= handleEither
  
  instance (ctx ~ UseDeriving gql args, gql a, Generic a, DecodeRep ctx (Rep a), GRep gql args (GQLResult (Value CONST)) (Rep a)) => KindedValue ctx TYPE a where
    encodeKindedValue ctx =
      repToValue
        . deriveValue
          ( GRepFun
              { grepFun = useEncodeValue ctx . runIdentity,
                grepTypename = useTypename ctx . inputType,
                grepWrappers = useWrappers ctx . inputType
              } ::
              GRepFun gql args Identity (GQLResult (Value CONST))
          )
        . unkind
    decodeKindedValue ctx _ = fmap to . (`runReaderT` context) . decodeRep ctx
      where
        context =
          Context
            { isVariantRef = False,
              typeName = useTypename ctx (InputType :: CatType IN a),
              enumVisitor = visitEnumName ctx proxy,
              fieldVisitor = visitFieldName ctx proxy
            }
          where
            proxy = Proxy @a
  
  instance (ctx ~ UseDeriving gql args, gql a, Generic a, DecodeRep ctx (Rep a), GRep gql args (GQLResult (Value CONST)) (Rep a)) => KindedValue ctx DIRECTIVE a where
    encodeKindedValue ctx =
      repToValue
        . deriveValue
          ( GRepFun
              { grepFun = useEncodeValue ctx . runIdentity,
                grepTypename = useTypename ctx . inputType,
                grepWrappers = useWrappers ctx . inputType
              } ::
              GRepFun gql args Identity (GQLResult (Value CONST))
          )
        . unkind
    decodeKindedValue ctx _ = fmap to . (`runReaderT` context) . decodeRep ctx
      where
        context =
          Context
            { isVariantRef = False,
              typeName = useTypename ctx (InputType :: CatType IN a),
              enumVisitor = visitEnumName ctx proxy,
              fieldVisitor = visitFieldName ctx proxy
            }
          where
            proxy = Proxy @a
  
  instance KindedValue ctx CUSTOM (Value CONST) where
    encodeKindedValue _ = pure . unkind
    decodeKindedValue _ _ = pure . toConstValue
  
  toConstValue :: ValidValue -> Value CONST
  toConstValue Null = Null
  toConstValue (Enum x) = Enum x
  toConstValue (Scalar x) = Scalar x
  toConstValue (List xs) = List (map toConstValue xs)
  toConstValue (Object fields) = Object (fmap toEntry fields)
    where
      toEntry :: ObjectEntry VALID -> ObjectEntry CONST
      toEntry ObjectEntry {..} = ObjectEntry {entryValue = toConstValue entryValue, ..}
  
  instance (ctx ~ UseDeriving gql args, KnownSymbol name, args a) => KindedValue ctx CUSTOM (Arg name a) where
    encodeKindedValue _ _ = throwError "directives cant be tagged arguments"
    decodeKindedValue ctx _ value = Arg <$> (coerceInputObject value >>= fieldDecoder)
      where
        fieldDecoder = useDecodeValue ctx . getField fieldName
        fieldName = symbolName (Proxy @name)
  
  --  Map
  instance (ctx ~ UseDeriving gql args, Ord k, args [(k, v)]) => KindedValue ctx CUSTOM (Map k v) where
    decodeKindedValue ctx _ v = unsafeFromList <$> (useDecodeValue ctx v :: ResolverState [(k, v)])
    encodeKindedValue ctx = useEncodeValue ctx . toAssoc . unkind
  
  --
  repToValue :: GRepValue (GQLResult (Value CONST)) -> GQLResult (Value CONST)
  repToValue GRepValueEnum {..} = pure $ Enum enumVariantName
  repToValue GRepValueObject {..} = Object <$> (traverse fromField objectFields >>= fromElems)
    where
      fromField GRepField {fieldSelector, fieldValue} = do
        entryValue <- fieldValue
        pure ObjectEntry {entryName = fieldSelector, entryValue}
  repToValue _ = throwError (internal "input unions are not supported")
  