{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Schema.Internal
  ( KindedType (..),
    TyContentM,
    TyContent,
    fromSchema,
    lookupDescription,
    lookupFieldContent,
  )
where

-- MORPHEUS

import qualified Data.Map as M
import Data.Morpheus.Internal.Ext
  ( GQLResult,
    Result (Failure, Success, errors),
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded
  ( KindedType (..),
  )
import Data.Morpheus.Server.Types.GQLType
  ( GQLType (..),
  )
import Data.Morpheus.Server.Types.SchemaT
  ( SchemaT,
  )
import Data.Morpheus.Types.Internal.AST
  ( CONST,
    Description,
    FieldContent (..),
    Schema (..),
    TRUE,
    VALID,
  )
import Language.Haskell.TH (Exp, Q)
import Relude hiding (empty)

lookupDescription :: GQLType a => f a -> Text -> Maybe Description
lookupDescription :: forall a (f :: * -> *). GQLType a => f a -> Text -> Maybe Text
lookupDescription f a
proxy Text
name = Text
name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` forall a (f :: * -> *). GQLType a => f a -> Map Text Text
getDescriptions f a
proxy

lookupFieldContent ::
  GQLType a =>
  KindedType kind a ->
  Text ->
  Maybe (FieldContent TRUE kind CONST)
lookupFieldContent :: forall a (kind :: TypeCategory).
GQLType a =>
KindedType kind a -> Text -> Maybe (FieldContent TRUE kind CONST)
lookupFieldContent proxy :: KindedType kind a
proxy@KindedType kind a
InputType Text
key = forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent ('IN <=? cat) cat s
DefaultInputValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
key forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` forall a (f :: * -> *). GQLType a => f a -> Map Text (Value CONST)
defaultValues KindedType kind a
proxy
lookupFieldContent KindedType kind a
OutputType Text
_ = forall a. Maybe a
Nothing

fromSchema :: GQLResult (Schema VALID) -> Q Exp
fromSchema :: GQLResult (Schema VALID) -> Q Exp
fromSchema Success {} = [|()|]
fromSchema Failure {NonEmpty GQLError
errors :: NonEmpty GQLError
errors :: forall err a. Result err a -> NonEmpty err
errors} = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall b a. (Show a, IsString b) => a -> b
show NonEmpty GQLError
errors)

type TyContentM kind = SchemaT kind (TyContent kind)

type TyContent kind = Maybe (FieldContent TRUE kind CONST)