{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.AST.TH
( ConsD (..),
mkCons,
isEnum,
mkConsEnum,
TypeNameTH (..),
)
where
import Data.Morpheus.Internal.Utils (elems)
import Data.Morpheus.Types.Internal.AST.Base
( FieldName,
TypeName,
TypeRef (..),
hsTypeName,
)
import Data.Morpheus.Types.Internal.AST.Fields
( FieldDefinition (..),
FieldsDefinition,
)
import Data.Morpheus.Types.Internal.AST.TypeSystem
( DataEnumValue (..),
)
import Relude
toHSFieldDefinition :: FieldDefinition cat s -> FieldDefinition cat s
toHSFieldDefinition :: FieldDefinition cat s -> FieldDefinition cat s
toHSFieldDefinition field :: FieldDefinition cat s
field@FieldDefinition {fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = tyRef :: TypeRef
tyRef@TypeRef {TypeName
typeConName :: TypeRef -> TypeName
typeConName :: TypeName
typeConName}} =
FieldDefinition cat s
field
{ fieldType :: TypeRef
fieldType = TypeRef
tyRef {typeConName :: TypeName
typeConName = TypeName -> TypeName
hsTypeName TypeName
typeConName}
}
data TypeNameTH = TypeNameTH
{ TypeNameTH -> [FieldName]
namespace :: [FieldName],
TypeNameTH -> TypeName
typename :: TypeName
}
deriving (Int -> TypeNameTH -> ShowS
[TypeNameTH] -> ShowS
TypeNameTH -> String
(Int -> TypeNameTH -> ShowS)
-> (TypeNameTH -> String)
-> ([TypeNameTH] -> ShowS)
-> Show TypeNameTH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeNameTH] -> ShowS
$cshowList :: [TypeNameTH] -> ShowS
show :: TypeNameTH -> String
$cshow :: TypeNameTH -> String
showsPrec :: Int -> TypeNameTH -> ShowS
$cshowsPrec :: Int -> TypeNameTH -> ShowS
Show)
data ConsD cat s = ConsD
{ ConsD cat s -> TypeName
cName :: TypeName,
ConsD cat s -> [FieldDefinition cat s]
cFields :: [FieldDefinition cat s]
}
deriving (Int -> ConsD cat s -> ShowS
[ConsD cat s] -> ShowS
ConsD cat s -> String
(Int -> ConsD cat s -> ShowS)
-> (ConsD cat s -> String)
-> ([ConsD cat s] -> ShowS)
-> Show (ConsD cat s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (cat :: TypeCategory) (s :: Stage).
Int -> ConsD cat s -> ShowS
forall (cat :: TypeCategory) (s :: Stage). [ConsD cat s] -> ShowS
forall (cat :: TypeCategory) (s :: Stage). ConsD cat s -> String
showList :: [ConsD cat s] -> ShowS
$cshowList :: forall (cat :: TypeCategory) (s :: Stage). [ConsD cat s] -> ShowS
show :: ConsD cat s -> String
$cshow :: forall (cat :: TypeCategory) (s :: Stage). ConsD cat s -> String
showsPrec :: Int -> ConsD cat s -> ShowS
$cshowsPrec :: forall (cat :: TypeCategory) (s :: Stage).
Int -> ConsD cat s -> ShowS
Show)
mkCons :: TypeName -> FieldsDefinition cat s -> ConsD cat s
mkCons :: TypeName -> FieldsDefinition cat s -> ConsD cat s
mkCons TypeName
typename FieldsDefinition cat s
fields =
ConsD :: forall (cat :: TypeCategory) (s :: Stage).
TypeName -> [FieldDefinition cat s] -> ConsD cat s
ConsD
{ cName :: TypeName
cName = TypeName -> TypeName
hsTypeName TypeName
typename,
cFields :: [FieldDefinition cat s]
cFields = (FieldDefinition cat s -> FieldDefinition cat s)
-> [FieldDefinition cat s] -> [FieldDefinition cat s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDefinition cat s -> FieldDefinition cat s
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldDefinition cat s
toHSFieldDefinition (FieldsDefinition cat s -> [FieldDefinition cat s]
forall a coll. Elems a coll => coll -> [a]
elems FieldsDefinition cat s
fields)
}
isEnum :: [ConsD cat s] -> Bool
isEnum :: [ConsD cat s] -> Bool
isEnum = (ConsD cat s -> Bool) -> [ConsD cat s] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([FieldDefinition cat s] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FieldDefinition cat s] -> Bool)
-> (ConsD cat s -> [FieldDefinition cat s]) -> ConsD cat s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsD cat s -> [FieldDefinition cat s]
forall (cat :: TypeCategory) (s :: Stage).
ConsD cat s -> [FieldDefinition cat s]
cFields)
mkConsEnum :: DataEnumValue s -> ConsD cat s
mkConsEnum :: DataEnumValue s -> ConsD cat s
mkConsEnum DataEnumValue {TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName :: TypeName
enumName} = ConsD :: forall (cat :: TypeCategory) (s :: Stage).
TypeName -> [FieldDefinition cat s] -> ConsD cat s
ConsD {cName :: TypeName
cName = TypeName -> TypeName
hsTypeName TypeName
enumName, cFields :: [FieldDefinition cat s]
cFields = []}