module Types where

import RIO

data Module = Module
  { Module -> ModuleName
name :: !ModuleName,
    Module -> [Import]
imports :: ![Import],
    Module -> [ModuleName]
declarationNames :: ![ModuleName],
    Module -> [TypeDefinition]
definitions :: ![TypeDefinition],
    Module -> FilePath
sourceFile :: !FilePath
  }
  deriving (Module -> Module -> Bool
(Module -> Module -> Bool)
-> (Module -> Module -> Bool) -> Eq Module
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c== :: Module -> Module -> Bool
Eq, Int -> Module -> ShowS
[Module] -> ShowS
Module -> FilePath
(Int -> Module -> ShowS)
-> (Module -> FilePath) -> ([Module] -> ShowS) -> Show Module
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Module] -> ShowS
$cshowList :: [Module] -> ShowS
show :: Module -> FilePath
$cshow :: Module -> FilePath
showsPrec :: Int -> Module -> ShowS
$cshowsPrec :: Int -> Module -> ShowS
Show)

newtype ModuleName = ModuleName Text
  deriving (ModuleName -> ModuleName -> Bool
(ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool) -> Eq ModuleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c== :: ModuleName -> ModuleName -> Bool
Eq, Int -> ModuleName -> ShowS
[ModuleName] -> ShowS
ModuleName -> FilePath
(Int -> ModuleName -> ShowS)
-> (ModuleName -> FilePath)
-> ([ModuleName] -> ShowS)
-> Show ModuleName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ModuleName] -> ShowS
$cshowList :: [ModuleName] -> ShowS
show :: ModuleName -> FilePath
$cshow :: ModuleName -> FilePath
showsPrec :: Int -> ModuleName -> ShowS
$cshowsPrec :: Int -> ModuleName -> ShowS
Show, Eq ModuleName
Eq ModuleName
-> (ModuleName -> ModuleName -> Ordering)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> ModuleName)
-> (ModuleName -> ModuleName -> ModuleName)
-> Ord ModuleName
ModuleName -> ModuleName -> Bool
ModuleName -> ModuleName -> Ordering
ModuleName -> ModuleName -> ModuleName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModuleName -> ModuleName -> ModuleName
$cmin :: ModuleName -> ModuleName -> ModuleName
max :: ModuleName -> ModuleName -> ModuleName
$cmax :: ModuleName -> ModuleName -> ModuleName
>= :: ModuleName -> ModuleName -> Bool
$c>= :: ModuleName -> ModuleName -> Bool
> :: ModuleName -> ModuleName -> Bool
$c> :: ModuleName -> ModuleName -> Bool
<= :: ModuleName -> ModuleName -> Bool
$c<= :: ModuleName -> ModuleName -> Bool
< :: ModuleName -> ModuleName -> Bool
$c< :: ModuleName -> ModuleName -> Bool
compare :: ModuleName -> ModuleName -> Ordering
$ccompare :: ModuleName -> ModuleName -> Ordering
$cp1Ord :: Eq ModuleName
Ord)

newtype Import = Import Module
  deriving (Import -> Import -> Bool
(Import -> Import -> Bool)
-> (Import -> Import -> Bool) -> Eq Import
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import -> Import -> Bool
$c/= :: Import -> Import -> Bool
== :: Import -> Import -> Bool
$c== :: Import -> Import -> Bool
Eq, Int -> Import -> ShowS
[Import] -> ShowS
Import -> FilePath
(Int -> Import -> ShowS)
-> (Import -> FilePath) -> ([Import] -> ShowS) -> Show Import
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Import] -> ShowS
$cshowList :: [Import] -> ShowS
show :: Import -> FilePath
$cshow :: Import -> FilePath
showsPrec :: Int -> Import -> ShowS
$cshowsPrec :: Int -> Import -> ShowS
Show)

newtype DefinitionName = DefinitionName {DefinitionName -> Text
unDefinitionName :: Text}
  deriving (DefinitionName -> DefinitionName -> Bool
(DefinitionName -> DefinitionName -> Bool)
-> (DefinitionName -> DefinitionName -> Bool) -> Eq DefinitionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefinitionName -> DefinitionName -> Bool
$c/= :: DefinitionName -> DefinitionName -> Bool
== :: DefinitionName -> DefinitionName -> Bool
$c== :: DefinitionName -> DefinitionName -> Bool
Eq, Int -> DefinitionName -> ShowS
[DefinitionName] -> ShowS
DefinitionName -> FilePath
(Int -> DefinitionName -> ShowS)
-> (DefinitionName -> FilePath)
-> ([DefinitionName] -> ShowS)
-> Show DefinitionName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DefinitionName] -> ShowS
$cshowList :: [DefinitionName] -> ShowS
show :: DefinitionName -> FilePath
$cshow :: DefinitionName -> FilePath
showsPrec :: Int -> DefinitionName -> ShowS
$cshowsPrec :: Int -> DefinitionName -> ShowS
Show)

data TypeDefinition = TypeDefinition !DefinitionName !TypeData
  deriving (TypeDefinition -> TypeDefinition -> Bool
(TypeDefinition -> TypeDefinition -> Bool)
-> (TypeDefinition -> TypeDefinition -> Bool) -> Eq TypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeDefinition -> TypeDefinition -> Bool
$c/= :: TypeDefinition -> TypeDefinition -> Bool
== :: TypeDefinition -> TypeDefinition -> Bool
$c== :: TypeDefinition -> TypeDefinition -> Bool
Eq, Int -> TypeDefinition -> ShowS
[TypeDefinition] -> ShowS
TypeDefinition -> FilePath
(Int -> TypeDefinition -> ShowS)
-> (TypeDefinition -> FilePath)
-> ([TypeDefinition] -> ShowS)
-> Show TypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TypeDefinition] -> ShowS
$cshowList :: [TypeDefinition] -> ShowS
show :: TypeDefinition -> FilePath
$cshow :: TypeDefinition -> FilePath
showsPrec :: Int -> TypeDefinition -> ShowS
$cshowsPrec :: Int -> TypeDefinition -> ShowS
Show)

data ImportedTypeDefinition = ImportedTypeDefinition
  { ImportedTypeDefinition -> ModuleName
sourceModule :: !ModuleName,
    ImportedTypeDefinition -> DefinitionName
name :: !DefinitionName,
    ImportedTypeDefinition -> TypeData
typeData :: !TypeData
  }
  deriving (ImportedTypeDefinition -> ImportedTypeDefinition -> Bool
(ImportedTypeDefinition -> ImportedTypeDefinition -> Bool)
-> (ImportedTypeDefinition -> ImportedTypeDefinition -> Bool)
-> Eq ImportedTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportedTypeDefinition -> ImportedTypeDefinition -> Bool
$c/= :: ImportedTypeDefinition -> ImportedTypeDefinition -> Bool
== :: ImportedTypeDefinition -> ImportedTypeDefinition -> Bool
$c== :: ImportedTypeDefinition -> ImportedTypeDefinition -> Bool
Eq, Int -> ImportedTypeDefinition -> ShowS
[ImportedTypeDefinition] -> ShowS
ImportedTypeDefinition -> FilePath
(Int -> ImportedTypeDefinition -> ShowS)
-> (ImportedTypeDefinition -> FilePath)
-> ([ImportedTypeDefinition] -> ShowS)
-> Show ImportedTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImportedTypeDefinition] -> ShowS
$cshowList :: [ImportedTypeDefinition] -> ShowS
show :: ImportedTypeDefinition -> FilePath
$cshow :: ImportedTypeDefinition -> FilePath
showsPrec :: Int -> ImportedTypeDefinition -> ShowS
$cshowsPrec :: Int -> ImportedTypeDefinition -> ShowS
Show)

newtype TypeTag = TypeTag Text
  deriving (TypeTag -> TypeTag -> Bool
(TypeTag -> TypeTag -> Bool)
-> (TypeTag -> TypeTag -> Bool) -> Eq TypeTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeTag -> TypeTag -> Bool
$c/= :: TypeTag -> TypeTag -> Bool
== :: TypeTag -> TypeTag -> Bool
$c== :: TypeTag -> TypeTag -> Bool
Eq, Int -> TypeTag -> ShowS
[TypeTag] -> ShowS
TypeTag -> FilePath
(Int -> TypeTag -> ShowS)
-> (TypeTag -> FilePath) -> ([TypeTag] -> ShowS) -> Show TypeTag
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TypeTag] -> ShowS
$cshowList :: [TypeTag] -> ShowS
show :: TypeTag -> FilePath
$cshow :: TypeTag -> FilePath
showsPrec :: Int -> TypeTag -> ShowS
$cshowsPrec :: Int -> TypeTag -> ShowS
Show)

newtype TypeVariable = TypeVariable Text
  deriving (TypeVariable -> TypeVariable -> Bool
(TypeVariable -> TypeVariable -> Bool)
-> (TypeVariable -> TypeVariable -> Bool) -> Eq TypeVariable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeVariable -> TypeVariable -> Bool
$c/= :: TypeVariable -> TypeVariable -> Bool
== :: TypeVariable -> TypeVariable -> Bool
$c== :: TypeVariable -> TypeVariable -> Bool
Eq, Int -> TypeVariable -> ShowS
[TypeVariable] -> ShowS
TypeVariable -> FilePath
(Int -> TypeVariable -> ShowS)
-> (TypeVariable -> FilePath)
-> ([TypeVariable] -> ShowS)
-> Show TypeVariable
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TypeVariable] -> ShowS
$cshowList :: [TypeVariable] -> ShowS
show :: TypeVariable -> FilePath
$cshow :: TypeVariable -> FilePath
showsPrec :: Int -> TypeVariable -> ShowS
$cshowsPrec :: Int -> TypeVariable -> ShowS
Show)

newtype ConstructorName = ConstructorName Text
  deriving (ConstructorName -> ConstructorName -> Bool
(ConstructorName -> ConstructorName -> Bool)
-> (ConstructorName -> ConstructorName -> Bool)
-> Eq ConstructorName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstructorName -> ConstructorName -> Bool
$c/= :: ConstructorName -> ConstructorName -> Bool
== :: ConstructorName -> ConstructorName -> Bool
$c== :: ConstructorName -> ConstructorName -> Bool
Eq, Int -> ConstructorName -> ShowS
[ConstructorName] -> ShowS
ConstructorName -> FilePath
(Int -> ConstructorName -> ShowS)
-> (ConstructorName -> FilePath)
-> ([ConstructorName] -> ShowS)
-> Show ConstructorName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorName] -> ShowS
$cshowList :: [ConstructorName] -> ShowS
show :: ConstructorName -> FilePath
$cshow :: ConstructorName -> FilePath
showsPrec :: Int -> ConstructorName -> ShowS
$cshowsPrec :: Int -> ConstructorName -> ShowS
Show)

newtype FieldName = FieldName Text
  deriving (FieldName -> FieldName -> Bool
(FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool) -> Eq FieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c== :: FieldName -> FieldName -> Bool
Eq, Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> FilePath
(Int -> FieldName -> ShowS)
-> (FieldName -> FilePath)
-> ([FieldName] -> ShowS)
-> Show FieldName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FieldName] -> ShowS
$cshowList :: [FieldName] -> ShowS
show :: FieldName -> FilePath
$cshow :: FieldName -> FilePath
showsPrec :: Int -> FieldName -> ShowS
$cshowsPrec :: Int -> FieldName -> ShowS
Show)

newtype EnumerationIdentifier = EnumerationIdentifier Text
  deriving (EnumerationIdentifier -> EnumerationIdentifier -> Bool
(EnumerationIdentifier -> EnumerationIdentifier -> Bool)
-> (EnumerationIdentifier -> EnumerationIdentifier -> Bool)
-> Eq EnumerationIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumerationIdentifier -> EnumerationIdentifier -> Bool
$c/= :: EnumerationIdentifier -> EnumerationIdentifier -> Bool
== :: EnumerationIdentifier -> EnumerationIdentifier -> Bool
$c== :: EnumerationIdentifier -> EnumerationIdentifier -> Bool
Eq, Int -> EnumerationIdentifier -> ShowS
[EnumerationIdentifier] -> ShowS
EnumerationIdentifier -> FilePath
(Int -> EnumerationIdentifier -> ShowS)
-> (EnumerationIdentifier -> FilePath)
-> ([EnumerationIdentifier] -> ShowS)
-> Show EnumerationIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EnumerationIdentifier] -> ShowS
$cshowList :: [EnumerationIdentifier] -> ShowS
show :: EnumerationIdentifier -> FilePath
$cshow :: EnumerationIdentifier -> FilePath
showsPrec :: Int -> EnumerationIdentifier -> ShowS
$cshowsPrec :: Int -> EnumerationIdentifier -> ShowS
Show)

-- | Defines what type tag field a union should have as well as the type tag location.
data TagType
  = -- | The union has the type tag with the rest of the payload.
    EmbeddedTypeTag FieldName
  | -- | The union has the type tag outside of the payload, wrapping it.
    StandardTypeTag FieldName
  deriving (TagType -> TagType -> Bool
(TagType -> TagType -> Bool)
-> (TagType -> TagType -> Bool) -> Eq TagType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagType -> TagType -> Bool
$c/= :: TagType -> TagType -> Bool
== :: TagType -> TagType -> Bool
$c== :: TagType -> TagType -> Bool
Eq, Int -> TagType -> ShowS
[TagType] -> ShowS
TagType -> FilePath
(Int -> TagType -> ShowS)
-> (TagType -> FilePath) -> ([TagType] -> ShowS) -> Show TagType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TagType] -> ShowS
$cshowList :: [TagType] -> ShowS
show :: TagType -> FilePath
$cshow :: TagType -> FilePath
showsPrec :: Int -> TagType -> ShowS
$cshowsPrec :: Int -> TagType -> ShowS
Show)

data TypeData
  = Struct !StructType
  | Union !FieldName !UnionType
  | EmbeddedUnion !FieldName ![EmbeddedConstructor]
  | UntaggedUnion ![FieldType]
  | Enumeration ![EnumerationValue]
  | DeclaredType !ModuleName ![TypeVariable]
  deriving (TypeData -> TypeData -> Bool
(TypeData -> TypeData -> Bool)
-> (TypeData -> TypeData -> Bool) -> Eq TypeData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeData -> TypeData -> Bool
$c/= :: TypeData -> TypeData -> Bool
== :: TypeData -> TypeData -> Bool
$c== :: TypeData -> TypeData -> Bool
Eq, Int -> TypeData -> ShowS
[TypeData] -> ShowS
TypeData -> FilePath
(Int -> TypeData -> ShowS)
-> (TypeData -> FilePath) -> ([TypeData] -> ShowS) -> Show TypeData
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TypeData] -> ShowS
$cshowList :: [TypeData] -> ShowS
show :: TypeData -> FilePath
$cshow :: TypeData -> FilePath
showsPrec :: Int -> TypeData -> ShowS
$cshowsPrec :: Int -> TypeData -> ShowS
Show)

data EmbeddedConstructor = EmbeddedConstructor !ConstructorName !(Maybe DefinitionReference)
  deriving (EmbeddedConstructor -> EmbeddedConstructor -> Bool
(EmbeddedConstructor -> EmbeddedConstructor -> Bool)
-> (EmbeddedConstructor -> EmbeddedConstructor -> Bool)
-> Eq EmbeddedConstructor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbeddedConstructor -> EmbeddedConstructor -> Bool
$c/= :: EmbeddedConstructor -> EmbeddedConstructor -> Bool
== :: EmbeddedConstructor -> EmbeddedConstructor -> Bool
$c== :: EmbeddedConstructor -> EmbeddedConstructor -> Bool
Eq, Int -> EmbeddedConstructor -> ShowS
[EmbeddedConstructor] -> ShowS
EmbeddedConstructor -> FilePath
(Int -> EmbeddedConstructor -> ShowS)
-> (EmbeddedConstructor -> FilePath)
-> ([EmbeddedConstructor] -> ShowS)
-> Show EmbeddedConstructor
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EmbeddedConstructor] -> ShowS
$cshowList :: [EmbeddedConstructor] -> ShowS
show :: EmbeddedConstructor -> FilePath
$cshow :: EmbeddedConstructor -> FilePath
showsPrec :: Int -> EmbeddedConstructor -> ShowS
$cshowsPrec :: Int -> EmbeddedConstructor -> ShowS
Show)

data StructType
  = PlainStruct ![StructField]
  | GenericStruct ![TypeVariable] ![StructField]
  deriving (StructType -> StructType -> Bool
(StructType -> StructType -> Bool)
-> (StructType -> StructType -> Bool) -> Eq StructType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StructType -> StructType -> Bool
$c/= :: StructType -> StructType -> Bool
== :: StructType -> StructType -> Bool
$c== :: StructType -> StructType -> Bool
Eq, Int -> StructType -> ShowS
[StructType] -> ShowS
StructType -> FilePath
(Int -> StructType -> ShowS)
-> (StructType -> FilePath)
-> ([StructType] -> ShowS)
-> Show StructType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StructType] -> ShowS
$cshowList :: [StructType] -> ShowS
show :: StructType -> FilePath
$cshow :: StructType -> FilePath
showsPrec :: Int -> StructType -> ShowS
$cshowsPrec :: Int -> StructType -> ShowS
Show)

data UnionType
  = PlainUnion ![Constructor]
  | GenericUnion ![TypeVariable] ![Constructor]
  deriving (UnionType -> UnionType -> Bool
(UnionType -> UnionType -> Bool)
-> (UnionType -> UnionType -> Bool) -> Eq UnionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnionType -> UnionType -> Bool
$c/= :: UnionType -> UnionType -> Bool
== :: UnionType -> UnionType -> Bool
$c== :: UnionType -> UnionType -> Bool
Eq, Int -> UnionType -> ShowS
[UnionType] -> ShowS
UnionType -> FilePath
(Int -> UnionType -> ShowS)
-> (UnionType -> FilePath)
-> ([UnionType] -> ShowS)
-> Show UnionType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UnionType] -> ShowS
$cshowList :: [UnionType] -> ShowS
show :: UnionType -> FilePath
$cshow :: UnionType -> FilePath
showsPrec :: Int -> UnionType -> ShowS
$cshowsPrec :: Int -> UnionType -> ShowS
Show)

data Constructor = Constructor !ConstructorName !(Maybe FieldType)
  deriving (Constructor -> Constructor -> Bool
(Constructor -> Constructor -> Bool)
-> (Constructor -> Constructor -> Bool) -> Eq Constructor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constructor -> Constructor -> Bool
$c/= :: Constructor -> Constructor -> Bool
== :: Constructor -> Constructor -> Bool
$c== :: Constructor -> Constructor -> Bool
Eq, Int -> Constructor -> ShowS
[Constructor] -> ShowS
Constructor -> FilePath
(Int -> Constructor -> ShowS)
-> (Constructor -> FilePath)
-> ([Constructor] -> ShowS)
-> Show Constructor
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Constructor] -> ShowS
$cshowList :: [Constructor] -> ShowS
show :: Constructor -> FilePath
$cshow :: Constructor -> FilePath
showsPrec :: Int -> Constructor -> ShowS
$cshowsPrec :: Int -> Constructor -> ShowS
Show)

data StructField = StructField !FieldName !FieldType
  deriving (StructField -> StructField -> Bool
(StructField -> StructField -> Bool)
-> (StructField -> StructField -> Bool) -> Eq StructField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StructField -> StructField -> Bool
$c/= :: StructField -> StructField -> Bool
== :: StructField -> StructField -> Bool
$c== :: StructField -> StructField -> Bool
Eq, Int -> StructField -> ShowS
[StructField] -> ShowS
StructField -> FilePath
(Int -> StructField -> ShowS)
-> (StructField -> FilePath)
-> ([StructField] -> ShowS)
-> Show StructField
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StructField] -> ShowS
$cshowList :: [StructField] -> ShowS
show :: StructField -> FilePath
$cshow :: StructField -> FilePath
showsPrec :: Int -> StructField -> ShowS
$cshowsPrec :: Int -> StructField -> ShowS
Show)

data EnumerationValue = EnumerationValue !EnumerationIdentifier !LiteralTypeValue
  deriving (EnumerationValue -> EnumerationValue -> Bool
(EnumerationValue -> EnumerationValue -> Bool)
-> (EnumerationValue -> EnumerationValue -> Bool)
-> Eq EnumerationValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumerationValue -> EnumerationValue -> Bool
$c/= :: EnumerationValue -> EnumerationValue -> Bool
== :: EnumerationValue -> EnumerationValue -> Bool
$c== :: EnumerationValue -> EnumerationValue -> Bool
Eq, Int -> EnumerationValue -> ShowS
[EnumerationValue] -> ShowS
EnumerationValue -> FilePath
(Int -> EnumerationValue -> ShowS)
-> (EnumerationValue -> FilePath)
-> ([EnumerationValue] -> ShowS)
-> Show EnumerationValue
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EnumerationValue] -> ShowS
$cshowList :: [EnumerationValue] -> ShowS
show :: EnumerationValue -> FilePath
$cshow :: EnumerationValue -> FilePath
showsPrec :: Int -> EnumerationValue -> ShowS
$cshowsPrec :: Int -> EnumerationValue -> ShowS
Show)

data FieldType
  = LiteralType !LiteralTypeValue
  | BasicType !BasicTypeValue
  | ComplexType !ComplexTypeValue
  | DefinitionReferenceType !DefinitionReference
  | RecursiveReferenceType !DefinitionName
  | TypeVariableReferenceType !TypeVariable
  deriving (FieldType -> FieldType -> Bool
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c== :: FieldType -> FieldType -> Bool
Eq, Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> FilePath
(Int -> FieldType -> ShowS)
-> (FieldType -> FilePath)
-> ([FieldType] -> ShowS)
-> Show FieldType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FieldType] -> ShowS
$cshowList :: [FieldType] -> ShowS
show :: FieldType -> FilePath
$cshow :: FieldType -> FilePath
showsPrec :: Int -> FieldType -> ShowS
$cshowsPrec :: Int -> FieldType -> ShowS
Show)

data DefinitionReference
  = DefinitionReference !TypeDefinition
  | ImportedDefinitionReference !ModuleName !TypeDefinition
  | AppliedGenericReference ![FieldType] !TypeDefinition
  | AppliedImportedGenericReference !ModuleName !AppliedTypes !TypeDefinition
  | DeclarationReference !ModuleName !DefinitionName
  | GenericDeclarationReference !ModuleName !DefinitionName !AppliedTypes
  deriving (DefinitionReference -> DefinitionReference -> Bool
(DefinitionReference -> DefinitionReference -> Bool)
-> (DefinitionReference -> DefinitionReference -> Bool)
-> Eq DefinitionReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefinitionReference -> DefinitionReference -> Bool
$c/= :: DefinitionReference -> DefinitionReference -> Bool
== :: DefinitionReference -> DefinitionReference -> Bool
$c== :: DefinitionReference -> DefinitionReference -> Bool
Eq, Int -> DefinitionReference -> ShowS
[DefinitionReference] -> ShowS
DefinitionReference -> FilePath
(Int -> DefinitionReference -> ShowS)
-> (DefinitionReference -> FilePath)
-> ([DefinitionReference] -> ShowS)
-> Show DefinitionReference
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DefinitionReference] -> ShowS
$cshowList :: [DefinitionReference] -> ShowS
show :: DefinitionReference -> FilePath
$cshow :: DefinitionReference -> FilePath
showsPrec :: Int -> DefinitionReference -> ShowS
$cshowsPrec :: Int -> DefinitionReference -> ShowS
Show)

newtype AppliedTypes = AppliedTypes [FieldType]
  deriving (AppliedTypes -> AppliedTypes -> Bool
(AppliedTypes -> AppliedTypes -> Bool)
-> (AppliedTypes -> AppliedTypes -> Bool) -> Eq AppliedTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppliedTypes -> AppliedTypes -> Bool
$c/= :: AppliedTypes -> AppliedTypes -> Bool
== :: AppliedTypes -> AppliedTypes -> Bool
$c== :: AppliedTypes -> AppliedTypes -> Bool
Eq, Int -> AppliedTypes -> ShowS
[AppliedTypes] -> ShowS
AppliedTypes -> FilePath
(Int -> AppliedTypes -> ShowS)
-> (AppliedTypes -> FilePath)
-> ([AppliedTypes] -> ShowS)
-> Show AppliedTypes
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AppliedTypes] -> ShowS
$cshowList :: [AppliedTypes] -> ShowS
show :: AppliedTypes -> FilePath
$cshow :: AppliedTypes -> FilePath
showsPrec :: Int -> AppliedTypes -> ShowS
$cshowsPrec :: Int -> AppliedTypes -> ShowS
Show)

data BasicTypeValue
  = U8
  | U16
  | U32
  | U64
  | U128
  | I8
  | I16
  | I32
  | I64
  | I128
  | F32
  | F64
  | Boolean
  | BasicString
  deriving (BasicTypeValue -> BasicTypeValue -> Bool
(BasicTypeValue -> BasicTypeValue -> Bool)
-> (BasicTypeValue -> BasicTypeValue -> Bool) -> Eq BasicTypeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasicTypeValue -> BasicTypeValue -> Bool
$c/= :: BasicTypeValue -> BasicTypeValue -> Bool
== :: BasicTypeValue -> BasicTypeValue -> Bool
$c== :: BasicTypeValue -> BasicTypeValue -> Bool
Eq, Int -> BasicTypeValue -> ShowS
[BasicTypeValue] -> ShowS
BasicTypeValue -> FilePath
(Int -> BasicTypeValue -> ShowS)
-> (BasicTypeValue -> FilePath)
-> ([BasicTypeValue] -> ShowS)
-> Show BasicTypeValue
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BasicTypeValue] -> ShowS
$cshowList :: [BasicTypeValue] -> ShowS
show :: BasicTypeValue -> FilePath
$cshow :: BasicTypeValue -> FilePath
showsPrec :: Int -> BasicTypeValue -> ShowS
$cshowsPrec :: Int -> BasicTypeValue -> ShowS
Show)

data ComplexTypeValue
  = SliceType FieldType
  | ArrayType Integer FieldType
  | OptionalType FieldType
  | PointerType FieldType
  deriving (ComplexTypeValue -> ComplexTypeValue -> Bool
(ComplexTypeValue -> ComplexTypeValue -> Bool)
-> (ComplexTypeValue -> ComplexTypeValue -> Bool)
-> Eq ComplexTypeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComplexTypeValue -> ComplexTypeValue -> Bool
$c/= :: ComplexTypeValue -> ComplexTypeValue -> Bool
== :: ComplexTypeValue -> ComplexTypeValue -> Bool
$c== :: ComplexTypeValue -> ComplexTypeValue -> Bool
Eq, Int -> ComplexTypeValue -> ShowS
[ComplexTypeValue] -> ShowS
ComplexTypeValue -> FilePath
(Int -> ComplexTypeValue -> ShowS)
-> (ComplexTypeValue -> FilePath)
-> ([ComplexTypeValue] -> ShowS)
-> Show ComplexTypeValue
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ComplexTypeValue] -> ShowS
$cshowList :: [ComplexTypeValue] -> ShowS
show :: ComplexTypeValue -> FilePath
$cshow :: ComplexTypeValue -> FilePath
showsPrec :: Int -> ComplexTypeValue -> ShowS
$cshowsPrec :: Int -> ComplexTypeValue -> ShowS
Show)

data LiteralTypeValue
  = LiteralString !Text
  | LiteralInteger !Integer
  | LiteralFloat !Float
  | LiteralBoolean !Bool
  deriving (LiteralTypeValue -> LiteralTypeValue -> Bool
(LiteralTypeValue -> LiteralTypeValue -> Bool)
-> (LiteralTypeValue -> LiteralTypeValue -> Bool)
-> Eq LiteralTypeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiteralTypeValue -> LiteralTypeValue -> Bool
$c/= :: LiteralTypeValue -> LiteralTypeValue -> Bool
== :: LiteralTypeValue -> LiteralTypeValue -> Bool
$c== :: LiteralTypeValue -> LiteralTypeValue -> Bool
Eq, Int -> LiteralTypeValue -> ShowS
[LiteralTypeValue] -> ShowS
LiteralTypeValue -> FilePath
(Int -> LiteralTypeValue -> ShowS)
-> (LiteralTypeValue -> FilePath)
-> ([LiteralTypeValue] -> ShowS)
-> Show LiteralTypeValue
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LiteralTypeValue] -> ShowS
$cshowList :: [LiteralTypeValue] -> ShowS
show :: LiteralTypeValue -> FilePath
$cshow :: LiteralTypeValue -> FilePath
showsPrec :: Int -> LiteralTypeValue -> ShowS
$cshowsPrec :: Int -> LiteralTypeValue -> ShowS
Show)