{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Transform.Core
  ( Converter (..),
    compileError,
    getType,
    typeFrom,
    deprecationWarning,
  )
where

import Control.Monad.Except (MonadError)
import Data.Morpheus.CodeGen.Internal.TH
  ( camelCaseTypeName,
  )
import Data.Morpheus.Error
  ( deprecatedField,
  )
import Data.Morpheus.Internal.Ext
  ( GQLResult,
    Result (..),
  )
import Data.Morpheus.Internal.Utils
  ( selectBy,
  )
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    Directives,
    FieldName,
    GQLError,
    RAW,
    Ref (..),
    Schema (..),
    TypeContent (..),
    TypeDefinition (..),
    TypeName,
    VALID,
    VariableDefinitions,
    internal,
    lookupDeprecated,
    lookupDeprecatedReason,
    msg,
    typeDefinitions,
  )
import Relude

type Env = (Schema VALID, VariableDefinitions RAW)

newtype Converter a = Converter
  { forall a. Converter a -> ReaderT Env GQLResult a
runConverter ::
      ReaderT
        Env
        GQLResult
        a
  }
  deriving
    ( forall a b. a -> Converter b -> Converter a
forall a b. (a -> b) -> Converter a -> Converter b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Converter b -> Converter a
$c<$ :: forall a b. a -> Converter b -> Converter a
fmap :: forall a b. (a -> b) -> Converter a -> Converter b
$cfmap :: forall a b. (a -> b) -> Converter a -> Converter b
Functor,
      Functor Converter
forall a. a -> Converter a
forall a b. Converter a -> Converter b -> Converter a
forall a b. Converter a -> Converter b -> Converter b
forall a b. Converter (a -> b) -> Converter a -> Converter b
forall a b c.
(a -> b -> c) -> Converter a -> Converter b -> Converter c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Converter a -> Converter b -> Converter a
$c<* :: forall a b. Converter a -> Converter b -> Converter a
*> :: forall a b. Converter a -> Converter b -> Converter b
$c*> :: forall a b. Converter a -> Converter b -> Converter b
liftA2 :: forall a b c.
(a -> b -> c) -> Converter a -> Converter b -> Converter c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Converter a -> Converter b -> Converter c
<*> :: forall a b. Converter (a -> b) -> Converter a -> Converter b
$c<*> :: forall a b. Converter (a -> b) -> Converter a -> Converter b
pure :: forall a. a -> Converter a
$cpure :: forall a. a -> Converter a
Applicative,
      Applicative Converter
forall a. a -> Converter a
forall a b. Converter a -> Converter b -> Converter b
forall a b. Converter a -> (a -> Converter b) -> Converter b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Converter a
$creturn :: forall a. a -> Converter a
>> :: forall a b. Converter a -> Converter b -> Converter b
$c>> :: forall a b. Converter a -> Converter b -> Converter b
>>= :: forall a b. Converter a -> (a -> Converter b) -> Converter b
$c>>= :: forall a b. Converter a -> (a -> Converter b) -> Converter b
Monad,
      MonadReader Env,
      MonadError GQLError
    )

compileError :: GQLError -> GQLError
compileError :: GQLError -> GQLError
compileError GQLError
x = GQLError -> GQLError
internal forall a b. (a -> b) -> a -> b
$ GQLError
"Unhandled Compile Time Error: \"" forall a. Semigroup a => a -> a -> a
<> GQLError
x forall a. Semigroup a => a -> a -> a
<> GQLError
"\" ;"

getType :: TypeName -> Converter (TypeDefinition ANY VALID)
getType :: TypeName -> Converter (TypeDefinition ANY VALID)
getType TypeName
typename =
  forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (s :: Stage).
Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (m :: * -> *) k (c :: * -> *) a.
(MonadError e m, IsMap k c, Monad m) =>
e -> k -> c a -> m a
selectBy (GQLError -> GQLError
compileError forall a b. (a -> b) -> a -> b
$ GQLError
" can't find Type" forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
typename) TypeName
typename

typeFrom :: [FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom :: forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom [FieldName]
path TypeDefinition {TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName :: TypeName
typeName, TypeContent TRUE a VALID
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE a VALID
typeContent} = TypeContent TRUE a VALID -> TypeName
__typeFrom TypeContent TRUE a VALID
typeContent
  where
    __typeFrom :: TypeContent TRUE a VALID -> TypeName
__typeFrom DataObject {} = forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [FieldName]
path TypeName
typeName
    __typeFrom DataInterface {} = forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [FieldName]
path TypeName
typeName
    __typeFrom DataUnion {} = forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [FieldName]
path TypeName
typeName
    __typeFrom TypeContent TRUE a VALID
_ = TypeName
typeName

deprecationWarning :: Directives VALID -> (FieldName, Ref FieldName) -> Converter ()
deprecationWarning :: Directives VALID -> (FieldName, Ref FieldName) -> Converter ()
deprecationWarning Directives VALID
dirs (FieldName
typename, Ref FieldName
ref) = case forall (s :: Stage). Directives s -> Maybe (Directive s)
lookupDeprecated Directives VALID
dirs of
  Just Directive VALID
deprecation -> forall a. ReaderT Env GQLResult a -> Converter a
Converter forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Success {result :: ()
result = (), [GQLError]
warnings :: [GQLError]
warnings :: [GQLError]
warnings}
    where
      warnings :: [GQLError]
warnings =
        [ FieldName -> Ref FieldName -> Maybe Description -> GQLError
deprecatedField
            FieldName
typename
            Ref FieldName
ref
            (forall (s :: Stage). Directive s -> Maybe Description
lookupDeprecatedReason Directive VALID
deprecation)
        ]
  Maybe (Directive VALID)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()