{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Declare.Type
  ( typeDeclarations,
  )
where

import Data.Morpheus.Client.Internal.TH (isTypeDeclared)
import Data.Morpheus.Client.Internal.Types
  ( ClientConstructorDefinition (..),
    ClientTypeDefinition (..),
    TypeNameTH (..),
  )
import Data.Morpheus.Client.Internal.Utils
  ( isEnum,
  )
import Data.Morpheus.CodeGen.Internal.TH
  ( camelCaseTypeName,
    declareTypeRef,
    toCon,
    toName,
  )
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    FieldDefinition (..),
    FieldName,
    TypeKind (..),
    TypeName,
    VALID,
  )
import Language.Haskell.TH
import Relude hiding (Type)

typeDeclarations :: TypeKind -> ClientTypeDefinition -> Q [Dec]
typeDeclarations :: TypeKind -> ClientTypeDefinition -> Q [Dec]
typeDeclarations TypeKind
KindScalar ClientTypeDefinition
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
typeDeclarations TypeKind
_ ClientTypeDefinition
c = do
  Bool
exists <- ClientTypeDefinition -> Q Bool
isTypeDeclared ClientTypeDefinition
c
  if Bool
exists
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure [ClientTypeDefinition -> Dec
declareType ClientTypeDefinition
c]

declareType :: ClientTypeDefinition -> Dec
declareType :: ClientTypeDefinition -> Dec
declareType
  ClientTypeDefinition
    { clientTypeName :: ClientTypeDefinition -> TypeNameTH
clientTypeName = thName :: TypeNameTH
thName@TypeNameTH {[FieldName]
namespace :: TypeNameTH -> [FieldName]
namespace :: [FieldName]
namespace, TypeName
typename :: TypeNameTH -> TypeName
typename :: TypeName
typename},
      [ClientConstructorDefinition]
clientCons :: ClientTypeDefinition -> [ClientConstructorDefinition]
clientCons :: [ClientConstructorDefinition]
clientCons
    } =
    Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD
      []
      ([FieldName] -> TypeName -> Name
mkConName [FieldName]
namespace TypeName
typename)
      []
      forall a. Maybe a
Nothing
      (TypeNameTH -> [ClientConstructorDefinition] -> [Con]
declareCons TypeNameTH
thName [ClientConstructorDefinition]
clientCons)
      (forall a b. (a -> b) -> [a] -> [b]
map Name -> DerivClause
derive [''Generic, ''Show, ''Eq])
    where
      derive :: Name -> DerivClause
derive Name
className = Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause forall a. Maybe a
Nothing [Name -> Type
ConT Name
className]

declareCons :: TypeNameTH -> [ClientConstructorDefinition] -> [Con]
declareCons :: TypeNameTH -> [ClientConstructorDefinition] -> [Con]
declareCons TypeNameTH {[FieldName]
namespace :: [FieldName]
namespace :: TypeNameTH -> [FieldName]
namespace, TypeName
typename :: TypeName
typename :: TypeNameTH -> TypeName
typename} [ClientConstructorDefinition]
clientCons
  | [ClientConstructorDefinition] -> Bool
isEnum [ClientConstructorDefinition]
clientCons = forall a b. (a -> b) -> [a] -> [b]
map ClientConstructorDefinition -> Con
consE [ClientConstructorDefinition]
clientCons
  | Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map ClientConstructorDefinition -> Con
consR [ClientConstructorDefinition]
clientCons
  where
    consE :: ClientConstructorDefinition -> Con
consE ClientConstructorDefinition {TypeName
cName :: ClientConstructorDefinition -> TypeName
cName :: TypeName
cName} = Name -> [BangType] -> Con
NormalC ([FieldName] -> TypeName -> TypeName -> Name
mkTypeName [FieldName]
namespace TypeName
typename TypeName
cName) []
    consR :: ClientConstructorDefinition -> Con
consR ClientConstructorDefinition {TypeName
cName :: TypeName
cName :: ClientConstructorDefinition -> TypeName
cName, [FieldDefinition ANY VALID]
cFields :: ClientConstructorDefinition -> [FieldDefinition ANY VALID]
cFields :: [FieldDefinition ANY VALID]
cFields} =
      Name -> [VarBangType] -> Con
RecC
        ([FieldName] -> TypeName -> Name
mkConName [FieldName]
namespace TypeName
cName)
        (forall a b. (a -> b) -> [a] -> [b]
map FieldDefinition ANY VALID -> VarBangType
declareField [FieldDefinition ANY VALID]
cFields)

declareField :: FieldDefinition ANY VALID -> (Name, Bang, Type)
declareField :: FieldDefinition ANY VALID -> VarBangType
declareField FieldDefinition {FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName :: FieldName
fieldName, TypeRef
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType :: TypeRef
fieldType} =
  ( forall a. ToName a => a -> Name
toName FieldName
fieldName,
    SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness,
    (TypeName -> Type) -> TypeRef -> Type
declareTypeRef forall a b. ToCon a b => a -> b
toCon TypeRef
fieldType
  )

mkTypeName :: [FieldName] -> TypeName -> TypeName -> Name
mkTypeName :: [FieldName] -> TypeName -> TypeName -> Name
mkTypeName [FieldName]
namespace TypeName
typename = [FieldName] -> TypeName -> Name
mkConName [FieldName]
namespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [TypeName
typename]

mkConName :: [FieldName] -> TypeName -> Name
mkConName :: [FieldName] -> TypeName -> Name
mkConName [FieldName]
namespace = forall a. ToName a => a -> Name
toName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [FieldName]
namespace