{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.AST.Type
  ( DataTypeWrapper (..),
    TypeRef (..),
    TypeWrapper (..),
    Nullable (..),
    Strictness (..),
    TypeKind (..),
    isWeaker,
    mkTypeRef,
    toGQLWrapper,
    toHSWrappers,
  )
where

import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    Rendering,
    render,
    renderGQL,
  )
import Data.Morpheus.Types.Internal.AST.Base
  ( FieldName (..),
    Msg (..),
    OperationType,
    TypeName (..),
  )
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Encoding (decodeUtf8)
import Language.Haskell.TH.Syntax (Lift (..))
import Relude hiding
  ( ByteString,
    decodeUtf8,
    intercalate,
  )

-- Kind
-----------------------------------------------------------------------------------
data TypeKind
  = KindScalar
  | KindObject (Maybe OperationType)
  | KindUnion
  | KindEnum
  | KindInputObject
  | KindList
  | KindNonNull
  | KindInputUnion
  | KindInterface
  deriving (TypeKind -> TypeKind -> Bool
(TypeKind -> TypeKind -> Bool)
-> (TypeKind -> TypeKind -> Bool) -> Eq TypeKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeKind -> TypeKind -> Bool
$c/= :: TypeKind -> TypeKind -> Bool
== :: TypeKind -> TypeKind -> Bool
$c== :: TypeKind -> TypeKind -> Bool
Eq, Int -> TypeKind -> ShowS
[TypeKind] -> ShowS
TypeKind -> String
(Int -> TypeKind -> ShowS)
-> (TypeKind -> String) -> ([TypeKind] -> ShowS) -> Show TypeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeKind] -> ShowS
$cshowList :: [TypeKind] -> ShowS
show :: TypeKind -> String
$cshow :: TypeKind -> String
showsPrec :: Int -> TypeKind -> ShowS
$cshowsPrec :: Int -> TypeKind -> ShowS
Show, TypeKind -> Q Exp
TypeKind -> Q (TExp TypeKind)
(TypeKind -> Q Exp)
-> (TypeKind -> Q (TExp TypeKind)) -> Lift TypeKind
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: TypeKind -> Q (TExp TypeKind)
$cliftTyped :: TypeKind -> Q (TExp TypeKind)
lift :: TypeKind -> Q Exp
$clift :: TypeKind -> Q Exp
Lift)

instance RenderGQL TypeKind where
  renderGQL :: TypeKind -> Rendering
renderGQL TypeKind
KindScalar = Rendering
"SCALAR"
  renderGQL KindObject {} = Rendering
"OBJECT"
  renderGQL TypeKind
KindUnion = Rendering
"UNION"
  renderGQL TypeKind
KindInputUnion = Rendering
"INPUT_OBJECT"
  renderGQL TypeKind
KindEnum = Rendering
"ENUM"
  renderGQL TypeKind
KindInputObject = Rendering
"INPUT_OBJECT"
  renderGQL TypeKind
KindList = Rendering
"LIST"
  renderGQL TypeKind
KindNonNull = Rendering
"NON_NULL"
  renderGQL TypeKind
KindInterface = Rendering
"INTERFACE"

--  Definitions:
--     Strictness:
--        Strict: Value (Strict) Types.
--             members: {scalar, enum , input}
--        Lazy: Resolver (lazy) Types
--             members: strict + {object, interface, union}
class Strictness t where
  isResolverType :: t -> Bool

instance Strictness TypeKind where
  isResolverType :: TypeKind -> Bool
isResolverType (KindObject Maybe OperationType
_) = Bool
True
  isResolverType TypeKind
KindUnion = Bool
True
  isResolverType TypeKind
KindInterface = Bool
True
  isResolverType TypeKind
_ = Bool
False

-- TypeWrappers
-----------------------------------------------------------------------------------

data TypeWrapper
  = TypeList
  | TypeMaybe
  deriving (Int -> TypeWrapper -> ShowS
[TypeWrapper] -> ShowS
TypeWrapper -> String
(Int -> TypeWrapper -> ShowS)
-> (TypeWrapper -> String)
-> ([TypeWrapper] -> ShowS)
-> Show TypeWrapper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeWrapper] -> ShowS
$cshowList :: [TypeWrapper] -> ShowS
show :: TypeWrapper -> String
$cshow :: TypeWrapper -> String
showsPrec :: Int -> TypeWrapper -> ShowS
$cshowsPrec :: Int -> TypeWrapper -> ShowS
Show, TypeWrapper -> TypeWrapper -> Bool
(TypeWrapper -> TypeWrapper -> Bool)
-> (TypeWrapper -> TypeWrapper -> Bool) -> Eq TypeWrapper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeWrapper -> TypeWrapper -> Bool
$c/= :: TypeWrapper -> TypeWrapper -> Bool
== :: TypeWrapper -> TypeWrapper -> Bool
$c== :: TypeWrapper -> TypeWrapper -> Bool
Eq, TypeWrapper -> Q Exp
TypeWrapper -> Q (TExp TypeWrapper)
(TypeWrapper -> Q Exp)
-> (TypeWrapper -> Q (TExp TypeWrapper)) -> Lift TypeWrapper
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: TypeWrapper -> Q (TExp TypeWrapper)
$cliftTyped :: TypeWrapper -> Q (TExp TypeWrapper)
lift :: TypeWrapper -> Q Exp
$clift :: TypeWrapper -> Q Exp
Lift)

data DataTypeWrapper
  = ListType
  | NonNullType
  deriving (Int -> DataTypeWrapper -> ShowS
[DataTypeWrapper] -> ShowS
DataTypeWrapper -> String
(Int -> DataTypeWrapper -> ShowS)
-> (DataTypeWrapper -> String)
-> ([DataTypeWrapper] -> ShowS)
-> Show DataTypeWrapper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataTypeWrapper] -> ShowS
$cshowList :: [DataTypeWrapper] -> ShowS
show :: DataTypeWrapper -> String
$cshow :: DataTypeWrapper -> String
showsPrec :: Int -> DataTypeWrapper -> ShowS
$cshowsPrec :: Int -> DataTypeWrapper -> ShowS
Show, DataTypeWrapper -> Q Exp
DataTypeWrapper -> Q (TExp DataTypeWrapper)
(DataTypeWrapper -> Q Exp)
-> (DataTypeWrapper -> Q (TExp DataTypeWrapper))
-> Lift DataTypeWrapper
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: DataTypeWrapper -> Q (TExp DataTypeWrapper)
$cliftTyped :: DataTypeWrapper -> Q (TExp DataTypeWrapper)
lift :: DataTypeWrapper -> Q Exp
$clift :: DataTypeWrapper -> Q Exp
Lift)

isWeaker :: [TypeWrapper] -> [TypeWrapper] -> Bool
isWeaker :: [TypeWrapper] -> [TypeWrapper] -> Bool
isWeaker (TypeWrapper
TypeMaybe : [TypeWrapper]
xs1) (TypeWrapper
TypeMaybe : [TypeWrapper]
xs2) = [TypeWrapper] -> [TypeWrapper] -> Bool
isWeaker [TypeWrapper]
xs1 [TypeWrapper]
xs2
isWeaker (TypeWrapper
TypeMaybe : [TypeWrapper]
_) [TypeWrapper]
_ = Bool
True
isWeaker (TypeWrapper
_ : [TypeWrapper]
xs1) (TypeWrapper
_ : [TypeWrapper]
xs2) = [TypeWrapper] -> [TypeWrapper] -> Bool
isWeaker [TypeWrapper]
xs1 [TypeWrapper]
xs2
isWeaker [TypeWrapper]
_ [TypeWrapper]
_ = Bool
False

toGQLWrapper :: [TypeWrapper] -> [DataTypeWrapper]
toGQLWrapper :: [TypeWrapper] -> [DataTypeWrapper]
toGQLWrapper (TypeWrapper
TypeMaybe : (TypeWrapper
TypeMaybe : [TypeWrapper]
tw)) = [TypeWrapper] -> [DataTypeWrapper]
toGQLWrapper (TypeWrapper
TypeMaybe TypeWrapper -> [TypeWrapper] -> [TypeWrapper]
forall a. a -> [a] -> [a]
: [TypeWrapper]
tw)
toGQLWrapper (TypeWrapper
TypeMaybe : (TypeWrapper
TypeList : [TypeWrapper]
tw)) = DataTypeWrapper
ListType DataTypeWrapper -> [DataTypeWrapper] -> [DataTypeWrapper]
forall a. a -> [a] -> [a]
: [TypeWrapper] -> [DataTypeWrapper]
toGQLWrapper [TypeWrapper]
tw
toGQLWrapper (TypeWrapper
TypeList : [TypeWrapper]
tw) = [DataTypeWrapper
NonNullType, DataTypeWrapper
ListType] [DataTypeWrapper] -> [DataTypeWrapper] -> [DataTypeWrapper]
forall a. Semigroup a => a -> a -> a
<> [TypeWrapper] -> [DataTypeWrapper]
toGQLWrapper [TypeWrapper]
tw
toGQLWrapper [TypeWrapper
TypeMaybe] = []
toGQLWrapper [] = [DataTypeWrapper
NonNullType]

toHSWrappers :: [DataTypeWrapper] -> [TypeWrapper]
toHSWrappers :: [DataTypeWrapper] -> [TypeWrapper]
toHSWrappers (DataTypeWrapper
NonNullType : (DataTypeWrapper
NonNullType : [DataTypeWrapper]
xs)) =
  [DataTypeWrapper] -> [TypeWrapper]
toHSWrappers (DataTypeWrapper
NonNullType DataTypeWrapper -> [DataTypeWrapper] -> [DataTypeWrapper]
forall a. a -> [a] -> [a]
: [DataTypeWrapper]
xs)
toHSWrappers (DataTypeWrapper
NonNullType : (DataTypeWrapper
ListType : [DataTypeWrapper]
xs)) = TypeWrapper
TypeList TypeWrapper -> [TypeWrapper] -> [TypeWrapper]
forall a. a -> [a] -> [a]
: [DataTypeWrapper] -> [TypeWrapper]
toHSWrappers [DataTypeWrapper]
xs
toHSWrappers (DataTypeWrapper
ListType : [DataTypeWrapper]
xs) = [TypeWrapper
TypeMaybe, TypeWrapper
TypeList] [TypeWrapper] -> [TypeWrapper] -> [TypeWrapper]
forall a. Semigroup a => a -> a -> a
<> [DataTypeWrapper] -> [TypeWrapper]
toHSWrappers [DataTypeWrapper]
xs
toHSWrappers [] = [TypeWrapper
TypeMaybe]
toHSWrappers [DataTypeWrapper
NonNullType] = []

renderWrapped :: RenderGQL a => a -> [TypeWrapper] -> Rendering
renderWrapped :: a -> [TypeWrapper] -> Rendering
renderWrapped a
x [TypeWrapper]
wrappers = [DataTypeWrapper] -> Rendering
showGQLWrapper ([TypeWrapper] -> [DataTypeWrapper]
toGQLWrapper [TypeWrapper]
wrappers)
  where
    showGQLWrapper :: [DataTypeWrapper] -> Rendering
showGQLWrapper [] = a -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL a
x
    showGQLWrapper (DataTypeWrapper
ListType : [DataTypeWrapper]
xs) = Rendering
"[" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [DataTypeWrapper] -> Rendering
showGQLWrapper [DataTypeWrapper]
xs Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"]"
    showGQLWrapper (DataTypeWrapper
NonNullType : [DataTypeWrapper]
xs) = [DataTypeWrapper] -> Rendering
showGQLWrapper [DataTypeWrapper]
xs Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"!"

-- TypeRef
-------------------------------------------------------------------
data TypeRef = TypeRef
  { TypeRef -> TypeName
typeConName :: TypeName,
    TypeRef -> [TypeWrapper]
typeWrappers :: [TypeWrapper]
  }
  deriving (Int -> TypeRef -> ShowS
[TypeRef] -> ShowS
TypeRef -> String
(Int -> TypeRef -> ShowS)
-> (TypeRef -> String) -> ([TypeRef] -> ShowS) -> Show TypeRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeRef] -> ShowS
$cshowList :: [TypeRef] -> ShowS
show :: TypeRef -> String
$cshow :: TypeRef -> String
showsPrec :: Int -> TypeRef -> ShowS
$cshowsPrec :: Int -> TypeRef -> ShowS
Show, TypeRef -> TypeRef -> Bool
(TypeRef -> TypeRef -> Bool)
-> (TypeRef -> TypeRef -> Bool) -> Eq TypeRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeRef -> TypeRef -> Bool
$c/= :: TypeRef -> TypeRef -> Bool
== :: TypeRef -> TypeRef -> Bool
$c== :: TypeRef -> TypeRef -> Bool
Eq, TypeRef -> Q Exp
TypeRef -> Q (TExp TypeRef)
(TypeRef -> Q Exp) -> (TypeRef -> Q (TExp TypeRef)) -> Lift TypeRef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: TypeRef -> Q (TExp TypeRef)
$cliftTyped :: TypeRef -> Q (TExp TypeRef)
lift :: TypeRef -> Q Exp
$clift :: TypeRef -> Q Exp
Lift)

mkTypeRef :: TypeName -> TypeRef
mkTypeRef :: TypeName -> TypeRef
mkTypeRef TypeName
typeConName = TypeRef :: TypeName -> [TypeWrapper] -> TypeRef
TypeRef {TypeName
typeConName :: TypeName
typeConName :: TypeName
typeConName, typeWrappers :: [TypeWrapper]
typeWrappers = []}

instance RenderGQL TypeRef where
  renderGQL :: TypeRef -> Rendering
renderGQL TypeRef {TypeName
typeConName :: TypeName
typeConName :: TypeRef -> TypeName
typeConName, [TypeWrapper]
typeWrappers :: [TypeWrapper]
typeWrappers :: TypeRef -> [TypeWrapper]
typeWrappers} = TypeName -> [TypeWrapper] -> Rendering
forall a. RenderGQL a => a -> [TypeWrapper] -> Rendering
renderWrapped TypeName
typeConName [TypeWrapper]
typeWrappers

instance Msg TypeRef where
  msg :: TypeRef -> Message
msg = FieldName -> Message
forall a. Msg a => a -> Message
msg (FieldName -> Message)
-> (TypeRef -> FieldName) -> TypeRef -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FieldName
FieldName (Text -> FieldName) -> (TypeRef -> Text) -> TypeRef -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text) -> (TypeRef -> Text) -> TypeRef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (TypeRef -> ByteString) -> TypeRef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> ByteString
forall a. RenderGQL a => a -> ByteString
render

class Nullable a where
  isNullable :: a -> Bool
  toNullable :: a -> a

instance Nullable [TypeWrapper] where
  isNullable :: [TypeWrapper] -> Bool
isNullable (TypeWrapper
TypeMaybe : [TypeWrapper]
_) = Bool
True
  isNullable [TypeWrapper]
_ = Bool
False
  toNullable :: [TypeWrapper] -> [TypeWrapper]
toNullable (TypeWrapper
TypeMaybe : [TypeWrapper]
xs) = TypeWrapper
TypeMaybe TypeWrapper -> [TypeWrapper] -> [TypeWrapper]
forall a. a -> [a] -> [a]
: [TypeWrapper]
xs
  toNullable [TypeWrapper]
xs = TypeWrapper
TypeMaybe TypeWrapper -> [TypeWrapper] -> [TypeWrapper]
forall a. a -> [a] -> [a]
: [TypeWrapper]
xs

instance Nullable TypeRef where
  isNullable :: TypeRef -> Bool
isNullable = [TypeWrapper] -> Bool
forall a. Nullable a => a -> Bool
isNullable ([TypeWrapper] -> Bool)
-> (TypeRef -> [TypeWrapper]) -> TypeRef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> [TypeWrapper]
typeWrappers
  toNullable :: TypeRef -> TypeRef
toNullable TypeRef {[TypeWrapper]
TypeName
typeWrappers :: [TypeWrapper]
typeConName :: TypeName
typeWrappers :: TypeRef -> [TypeWrapper]
typeConName :: TypeRef -> TypeName
..} = TypeRef :: TypeName -> [TypeWrapper] -> TypeRef
TypeRef {typeWrappers :: [TypeWrapper]
typeWrappers = [TypeWrapper] -> [TypeWrapper]
forall a. Nullable a => a -> a
toNullable [TypeWrapper]
typeWrappers, TypeName
typeConName :: TypeName
typeConName :: TypeName
..}