gotyno-hs-1.0.0: src/CodeGeneration/Python.hs
module CodeGeneration.Python (outputModule) where
import CodeGeneration.Utilities (upperCaseFirstCharacter)
import RIO
import qualified RIO.Text as Text
import Types
outputModule :: Module -> Text
outputModule Module {definitions, imports, declarationNames} =
let definitionOutput = definitions & mapMaybe outputDefinition & Text.intercalate "\n\n"
importsOutput = imports & fmap outputImport & Text.intercalate "\n"
outputImport (Import Module {name = ModuleName importName}) =
mconcat ["from . import ", importName]
declarationImportsOutput =
declarationNames
& fmap
( \(ModuleName name) ->
mconcat ["from . import ", name]
)
& Text.intercalate "\n"
in mconcat
[ mconcat
[ "import json\n",
"import typing\n",
"from dataclasses import dataclass\n",
"from gotyno_validation import validation\n",
"from gotyno_validation import encoding\n\n"
],
importsOutput,
if null imports then "" else "\n\n",
declarationImportsOutput,
if null declarationNames then "" else "\n\n",
definitionOutput
]
outputDefinition :: TypeDefinition -> Maybe Text
outputDefinition (TypeDefinition (DefinitionName name) (Struct (PlainStruct fields))) =
pure $ outputPlainStruct name fields
outputDefinition (TypeDefinition (DefinitionName name) (Struct (GenericStruct typeVariables fields))) =
pure $ outputGenericStruct name typeVariables fields
outputDefinition (TypeDefinition (DefinitionName name) (Union typeTag unionType)) =
pure $ outputUnion name typeTag unionType
outputDefinition (TypeDefinition (DefinitionName name) (Enumeration enumerationValues)) =
pure $ outputEnumeration name enumerationValues
outputDefinition (TypeDefinition (DefinitionName name) (UntaggedUnion unionCases)) =
pure $ outputUntaggedUnion name unionCases
outputDefinition (TypeDefinition (DefinitionName name) (EmbeddedUnion typeTag constructors)) =
pure $ outputEmbeddedUnion name typeTag constructors
outputDefinition (TypeDefinition _name (DeclaredType _moduleName _typeVariables)) = Nothing
outputEmbeddedUnion :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedUnion unionName fieldName constructors =
let baseClassOutput =
outputUnionBaseClass
unionName
fieldName
(embeddedConstructorsToConstructors constructors)
[]
casesOutput = outputEmbeddedUnionCases unionName fieldName constructors
in mconcat [baseClassOutput, "\n\n", casesOutput]
outputEmbeddedUnionCases :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedUnionCases unionName fieldName =
fmap (outputEmbeddedUnionCase unionName fieldName) >>> Text.intercalate "\n\n"
outputEmbeddedUnionCase :: Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedUnionCase
unionName
tag
constructor@(EmbeddedConstructor (ConstructorName name) Nothing) =
let validatorOutput = outputEmbeddedConstructorDecoder tag constructor
encoderOutput = outputEmbeddedConstructorEncoder tag constructor
in mconcat
[ "@dataclass\n",
mconcat ["class ", upperCaseFirstCharacter name, "(", unionName, "):\n"],
validatorOutput,
"\n\n",
encoderOutput
]
outputEmbeddedUnionCase
unionName
tag
constructor@(EmbeddedConstructor (ConstructorName name) (Just reference)) =
let structFields = structFieldsFromReference reference
typesOutput =
structFields
& fmap
( \(StructField (FieldName n) fieldType) ->
mconcat [" ", n, ": ", outputFieldType fieldType]
)
& Text.intercalate "\n"
validatorOutput = outputEmbeddedConstructorDecoder tag constructor
encoderOutput = outputEmbeddedConstructorEncoder tag constructor
in mconcat
[ "@dataclass\n",
mconcat ["class ", upperCaseFirstCharacter name, "(", unionName, "):\n"],
typesOutput,
"\n\n",
validatorOutput,
"\n\n",
encoderOutput
]
outputEmbeddedConstructorDecoder :: FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorDecoder
(FieldName tag)
(EmbeddedConstructor (ConstructorName name) Nothing) =
let typeName = upperCaseFirstCharacter name
in mconcat
[ " @staticmethod\n",
mconcat [" def validate(value: validation.Unknown) -> validation.ValidationResult['", typeName, "']:\n"],
mconcat
[ " return validation.validate_with_type_tag_and_validator(value, '",
tag,
"', '",
name,
"', validation.validate_unknown, ",
typeName,
")\n\n"
],
" @staticmethod\n",
mconcat
[ " def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
typeName,
"']:\n"
],
mconcat [" return validation.validate_from_string(string, ", typeName, ".validate)"]
]
outputEmbeddedConstructorDecoder
(FieldName tag)
(EmbeddedConstructor (ConstructorName name) (Just reference)) =
let typeName = upperCaseFirstCharacter name
DefinitionName referenceName = nameOfReference reference
in mconcat
[ " @staticmethod\n",
mconcat [" def validate(value: validation.Unknown) -> validation.ValidationResult['", typeName, "']:\n"],
mconcat
[ " return validation.validate_with_type_tag_and_validator(value, '",
tag,
"', '",
name,
"', ",
referenceName,
".validate, ",
typeName,
")\n\n"
],
" @staticmethod\n",
mconcat
[ " def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
typeName,
"']:\n"
],
mconcat [" return validation.validate_from_string(string, ", typeName, ".validate)"]
]
outputEmbeddedConstructorEncoder :: FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorEncoder
(FieldName tag)
(EmbeddedConstructor (ConstructorName name) Nothing) =
let interface = mconcat ["{'", tag, "': '", name, "'}"]
in mconcat
[ " def to_json(self) -> typing.Dict[str, typing.Any]:\n",
mconcat [" return ", interface, "\n\n"],
" def encode(self) -> str:\n",
" return json.dumps(self.to_json())"
]
outputEmbeddedConstructorEncoder
(FieldName tag)
(EmbeddedConstructor (ConstructorName name) (Just reference)) =
let DefinitionName referenceName = nameOfReference reference
interface = mconcat ["{'", tag, "': '", name, "', **", referenceName, ".to_json(self)}"]
in mconcat
[ " def to_json(self) -> typing.Dict[str, typing.Any]:\n",
mconcat [" return ", interface, "\n\n"],
" def encode(self) -> str:\n",
" return json.dumps(self.to_json())"
]
structFieldsFromReference :: DefinitionReference -> [StructField]
structFieldsFromReference
(DefinitionReference (TypeDefinition _name (Struct (PlainStruct fields)))) = fields
structFieldsFromReference _other = error "struct fields from anything other than plain struct"
embeddedConstructorsToConstructors :: [EmbeddedConstructor] -> [Constructor]
embeddedConstructorsToConstructors = fmap embeddedConstructorToConstructor
embeddedConstructorToConstructor :: EmbeddedConstructor -> Constructor
embeddedConstructorToConstructor (EmbeddedConstructor name reference) =
Constructor name (DefinitionReferenceType <$> reference)
outputUntaggedUnion :: Text -> [FieldType] -> Text
outputUntaggedUnion unionName cases =
let typeOutput = mconcat [unionName, " = ", "typing.Union[", unionOutput, "]"]
unionOutput = cases & fmap outputCase & Text.intercalate ", "
outputCase fieldType = outputFieldType fieldType
interfaceOutput = outputUntaggedUnionInterface unionName cases
in mconcat [typeOutput, "\n", interfaceOutput]
outputUntaggedUnionInterface :: Text -> [FieldType] -> Text
outputUntaggedUnionInterface unionName cases =
let oneOfValidatorsOutput =
mconcat
[ "[",
cases
& fmap validatorForFieldType
& Text.intercalate ", ",
"]"
]
oneOfToJSONInterface =
mconcat
[ "{",
cases
& fmap
( \fieldType ->
fieldTypeName fieldType <> ": " <> encoderForFieldType ("", "") fieldType
)
& Text.intercalate ", ",
"}"
]
in mconcat
[ mconcat ["class ", unionName, "Interface:\n"],
" @staticmethod\n",
mconcat
[ " def validate(value: validation.Unknown) -> validation.ValidationResult['",
unionName,
"']:\n"
],
mconcat
[ " return validation.validate_one_of(value, ",
oneOfValidatorsOutput,
")\n\n"
],
" @staticmethod\n",
mconcat
[ " def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
unionName,
"']:\n"
],
mconcat
[ " return validation.validate_from_string(string, ",
unionName,
"Interface.validate)\n\n"
],
" @staticmethod\n",
" def to_json(value) -> typing.Any:\n",
mconcat
[" return encoding.one_of_to_json(value, ", oneOfToJSONInterface, ")\n\n"],
" @staticmethod\n",
" def encode(value) -> str:\n",
" return json.dumps(value.to_json())"
]
outputEnumeration :: Text -> [EnumerationValue] -> Text
outputEnumeration name values =
let typeOutput = outputEnumerationType name values
validatorOutput = outputEnumerationValidator name
decoderOutput = outputEnumerationDecoder name
encoderOutput = outputEnumerationEncoder
in mconcat [typeOutput, "\n\n", validatorOutput, "\n\n", decoderOutput, "\n\n", encoderOutput]
outputEnumerationType :: Text -> [EnumerationValue] -> Text
outputEnumerationType name values =
let valuesOutput =
values
& fmap
( \(EnumerationValue (EnumerationIdentifier i) literal) ->
mconcat [" ", i, " = ", literalValue literal]
)
& Text.intercalate "\n"
literalValue (LiteralString s) = "'" <> s <> "'"
literalValue (LiteralInteger i) = tshow i
literalValue (LiteralFloat f) = tshow f
literalValue (LiteralBoolean b) = tshow b
in mconcat [mconcat ["class ", name, "(enum.Enum):\n"], valuesOutput]
outputEnumerationValidator :: Text -> Text
outputEnumerationValidator name =
mconcat
[ " @staticmethod\n",
mconcat
[ " def validate(value: validation.Unknown) -> validation.ValidationResult['",
name,
"']:\n"
],
mconcat [" return validation.validate_enumeration_member(value, ", name, ")"]
]
outputEnumerationDecoder :: Text -> Text
outputEnumerationDecoder name =
mconcat
[ " @staticmethod\n",
mconcat
[ " def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
name,
"']:\n"
],
mconcat [" return validation.validate_from_string(string, ", name, ".validate)"]
]
outputEnumerationEncoder :: Text
outputEnumerationEncoder =
mconcat
[ " def to_json(self) -> typing.Any:\n",
" return self.value\n\n",
" def encode(self) -> str:\n",
" return str(self.value)"
]
outputPlainStruct :: Text -> [StructField] -> Text
outputPlainStruct name fields =
let fieldsOutput = fields & fmap (outputField 4) & Text.intercalate "\n"
validatorOutput = outputStructValidator name fields []
encoderOutput = outputStructEncoder fields []
decoderOutput = outputStructDecoder name []
in mconcat
[ mconcat ["@dataclass(frozen=True)\nclass ", name, ":\n"],
fieldsOutput,
"\n\n",
validatorOutput,
"\n\n",
decoderOutput,
"\n\n",
encoderOutput
]
outputGenericStruct :: Text -> [TypeVariable] -> [StructField] -> Text
outputGenericStruct name typeVariables fields =
let fullName = mconcat [name, "(typing.Generic", joinTypeVariables typeVariables, ")"]
typeOutput =
mconcat
[ mconcat ["@dataclass(frozen=True)\nclass ", fullName, ":\n"],
fieldsOutput
]
fieldsOutput = fields & fmap (outputField 4) & Text.intercalate "\n"
validatorOutput = outputStructValidator name fields typeVariables
decoderOutput = outputStructDecoder name typeVariables
encoderOutput = outputStructEncoder fields typeVariables
typeVariableOutput = typeVariables & fmap outputTypeVariableDefinition & Text.intercalate "\n"
outputTypeVariableDefinition (TypeVariable t) = mconcat [t, " = typing.TypeVar('", t, "')"]
in mconcat
[ typeVariableOutput,
"\n",
typeOutput,
"\n\n",
validatorOutput,
"\n\n",
decoderOutput,
"\n\n",
encoderOutput
]
outputStructValidator :: Text -> [StructField] -> [TypeVariable] -> Text
outputStructValidator name fields typeVariables =
let validateFunctionOutput =
if null typeVariables
then plainValidator
else genericValidator
fullName =
if null typeVariables
then name
else mconcat [name, joinTypeVariables typeVariables]
plainValidator =
mconcat
[ mconcat
[ " def validate(value: validation.Unknown) -> validation.ValidationResult['",
name,
"']:\n"
],
mconcat
[ " return validation.validate_interface(value, ",
interface,
", ",
name,
")"
]
]
genericValidator =
let validatorName =
mconcat
[ "validate_",
name,
typeVariables & fmap (\(TypeVariable t) -> t) & Text.intercalate ""
]
in mconcat
[ mconcat
[ " def validate(",
typeVariableValidatorsAsArguments typeVariables,
") -> validation.Validator['",
fullName,
"']:\n"
],
mconcat
[ " def ",
validatorName,
"(value: validation.Unknown) -> validation.ValidationResult['",
fullName,
"']:\n"
],
mconcat
[ " return validation.validate_interface(value, ",
interface,
", ",
name,
")\n"
],
mconcat [" return ", validatorName]
]
interface =
mconcat ["{", fields & fmap outputValidatorForField & Text.intercalate ", ", "}"]
in mconcat [" @staticmethod\n", validateFunctionOutput]
outputStructDecoder :: Text -> [TypeVariable] -> Text
outputStructDecoder name typeVariables =
let decodeFunctionOutput =
if null typeVariables
then plainDecoder
else genericDecoder
fullName =
if null typeVariables
then name
else mconcat [name, joinTypeVariables typeVariables]
plainDecoder =
mconcat
[ mconcat
[ mconcat
[ " def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
name,
"']:\n"
]
],
mconcat [" return validation.validate_from_string(string, ", name, ".validate)"]
]
genericDecoder =
mconcat
[ mconcat
[ " def decode(string: typing.Union[str, bytes], ",
validatorArguments,
") -> validation.ValidationResult['",
fullName,
"']:\n"
],
mconcat
[ " return validation.validate_from_string(string, ",
name,
".validate(",
typeVariables
& fmap (TypeVariableReferenceType >>> validatorForFieldType)
& Text.intercalate ", ",
"))"
]
]
validatorArguments =
typeVariableValidatorsAsArguments typeVariables
in mconcat [" @staticmethod\n", decodeFunctionOutput]
outputStructEncoder :: [StructField] -> [TypeVariable] -> Text
outputStructEncoder fields typeVariables =
let interface =
mconcat
["{", fields & fmap outputEncoderForField & Text.intercalate ", ", "}"]
maybeTypeVariableToJSONArguments =
if null typeVariables
then ""
else
", "
<> ( typeVariables
& fmap
( \(TypeVariable t) ->
mconcat [t, "_to_json: encoding.ToJSON[", t, "]"]
)
& Text.intercalate ", "
)
maybePassedInToJSONs =
if null typeVariables
then ""
else typeVariables & fmap (\(TypeVariable t) -> t <> "_to_json") & Text.intercalate ", "
in mconcat
[ mconcat [" def to_json(self", maybeTypeVariableToJSONArguments, ") -> typing.Dict[str, typing.Any]:\n"],
mconcat [" return ", interface, "\n\n"],
mconcat [" def encode(self", maybeTypeVariableToJSONArguments, ") -> str:\n"],
mconcat [" return json.dumps(self.to_json(", maybePassedInToJSONs, "))"]
]
outputValidatorForField :: StructField -> Text
outputValidatorForField (StructField (FieldName fieldName) fieldType) =
mconcat
[ "'",
fieldName,
"': ",
validatorForFieldType fieldType
]
outputEncoderForField :: StructField -> Text
outputEncoderForField
(StructField (FieldName fieldName) fieldType@(LiteralType _)) =
mconcat ["'", fieldName, "': ", encoderForFieldType ("", "") fieldType]
outputEncoderForField
(StructField (FieldName fieldName) basicType@(BasicType t))
| t `elem` [U64, U128, I64, I128] =
mconcat
[ "'",
fieldName,
"': ",
encoderForFieldType ("", "") basicType,
"(self.",
fieldName,
")"
]
| otherwise = mconcat ["'", fieldName, "': self.", fieldName]
outputEncoderForField
( StructField
(FieldName fieldName)
(DefinitionReferenceType (AppliedGenericReference appliedTypeVariables _definition))
) =
let passedInToJSONs =
appliedTypeVariables & fmap (encoderForFieldType ("", "")) & Text.intercalate ", "
in mconcat ["'", fieldName, "': self.", fieldName, ".to_json(", passedInToJSONs, ")"]
outputEncoderForField
( StructField
(FieldName fieldName)
( DefinitionReferenceType
( AppliedImportedGenericReference
_moduleName
(AppliedTypes appliedTypeVariables)
_definition
)
)
) =
let passedInToJSONs =
appliedTypeVariables & fmap (encoderForFieldType ("", "")) & Text.intercalate ", "
in mconcat ["'", fieldName, "': self.", fieldName, ".to_json(", passedInToJSONs, ")"]
outputEncoderForField (StructField (FieldName fieldName) fieldType) =
mconcat
[ "'",
fieldName,
"': ",
encoderForFieldType ("", "") fieldType,
"(self.",
fieldName,
")"
]
encoderForFieldType :: (Text, Text) -> FieldType -> Text
encoderForFieldType (_l, _r) (LiteralType literalType) = encoderForLiteralType literalType
encoderForFieldType (_l, _r) (BasicType basicType) = encoderForBasicType basicType
encoderForFieldType (l, r) (ComplexType complexType) = l <> encoderForComplexType complexType <> r
encoderForFieldType (_l, _r) (DefinitionReferenceType definitionReference) =
encoderForDefinitionReference definitionReference
encoderForFieldType (_l, _r) (TypeVariableReferenceType (TypeVariable name)) = name <> "_to_json"
encoderForFieldType (_l, _r) (RecursiveReferenceType (DefinitionName name)) = name <> ".to_json"
encoderForBasicType :: BasicTypeValue -> Text
encoderForBasicType U64 = "encoding.bigint_to_json"
encoderForBasicType U128 = "encoding.bigint_to_json"
encoderForBasicType I64 = "encoding.bigint_to_json"
encoderForBasicType I128 = "encoding.bigint_to_json"
encoderForBasicType _ = "encoding.basic_to_json"
encoderForLiteralType :: LiteralTypeValue -> Text
encoderForLiteralType (LiteralString s) = "'" <> s <> "'"
encoderForLiteralType (LiteralInteger i) = tshow i
encoderForLiteralType (LiteralFloat f) = tshow f
encoderForLiteralType (LiteralBoolean b) = tshow b
encoderForComplexType :: ComplexTypeValue -> Text
encoderForComplexType (PointerType fieldType) = encoderForFieldType ("", "") fieldType
encoderForComplexType (ArrayType _size fieldType) =
mconcat ["encoding.list_to_json(", encoderForFieldType ("(", ")") fieldType, ")"]
encoderForComplexType (SliceType fieldType) =
mconcat ["encoding.list_to_json(", encoderForFieldType ("(", ")") fieldType, ")"]
encoderForComplexType (OptionalType fieldType) =
mconcat ["encoding.optional_to_json(", encoderForFieldType ("(", ")") fieldType, ")"]
encoderForDefinitionReference :: DefinitionReference -> Text
encoderForDefinitionReference
( DefinitionReference
(TypeDefinition (DefinitionName name) _typeData)
) =
name <> ".to_json"
encoderForDefinitionReference
( ImportedDefinitionReference
(ModuleName moduleName)
(TypeDefinition (DefinitionName name) _typeData)
) =
mconcat [moduleName, ".", name, ".to_json"]
encoderForDefinitionReference
( AppliedGenericReference
appliedTypes
(TypeDefinition (DefinitionName name) _typeData)
) =
let appliedEncoders = appliedTypes & fmap (encoderForFieldType ("", "")) & Text.intercalate " "
in mconcat [name, ".to_json(", appliedEncoders, ")"]
encoderForDefinitionReference
( AppliedImportedGenericReference
(ModuleName moduleName)
(AppliedTypes appliedTypes)
(TypeDefinition (DefinitionName name) _typeData)
) =
let appliedEncoders = appliedTypes & fmap (encoderForFieldType ("", "")) & Text.intercalate " "
in mconcat [moduleName, ".", name, ".to_json(", appliedEncoders, ")"]
encoderForDefinitionReference
( GenericDeclarationReference
(ModuleName moduleName)
(DefinitionName name)
(AppliedTypes appliedTypes)
) =
let appliedEncoders = appliedTypes & fmap (encoderForFieldType ("", "")) & Text.intercalate " "
in mconcat [moduleName, ".", name, ".to_json(", appliedEncoders, ")"]
encoderForDefinitionReference
(DeclarationReference (ModuleName moduleName) (DefinitionName name)) =
mconcat [moduleName, ".", name, ".to_json"]
validatorForFieldType :: FieldType -> Text
validatorForFieldType (LiteralType literalType) = validatorForLiteralType literalType
validatorForFieldType (BasicType basicType) = validatorForBasicType basicType
validatorForFieldType (ComplexType complexType) = validatorForComplexType complexType
validatorForFieldType (DefinitionReferenceType definitionReference) =
decoderForDefinitionReference definitionReference
validatorForFieldType (TypeVariableReferenceType (TypeVariable name)) = "validate_" <> name
validatorForFieldType (RecursiveReferenceType (DefinitionName name)) = name <> ".decode"
validatorForBasicType :: BasicTypeValue -> Text
validatorForBasicType BasicString = "validation.validate_string"
validatorForBasicType U8 = "validation.validate_int"
validatorForBasicType U16 = "validation.validate_int"
validatorForBasicType U32 = "validation.validate_int"
validatorForBasicType U64 = "validation.validate_bigint"
validatorForBasicType U128 = "validation.validate_bigint"
validatorForBasicType I8 = "validation.validate_int"
validatorForBasicType I16 = "validation.validate_int"
validatorForBasicType I32 = "validation.validate_int"
validatorForBasicType I64 = "validation.validate_bigint"
validatorForBasicType I128 = "validation.validate_bigint"
validatorForBasicType F32 = "validation.validate_float"
validatorForBasicType F64 = "validation.validate_float"
validatorForBasicType Boolean = "validation.validate_bool"
validatorForLiteralType :: LiteralTypeValue -> Text
validatorForLiteralType (LiteralString s) = "validation.validate_literal(\'" <> s <> "\')"
validatorForLiteralType (LiteralInteger i) = "validation.validate_literal(" <> tshow i <> ")"
validatorForLiteralType (LiteralFloat f) = "validation.validate_literal(" <> tshow f <> ")"
validatorForLiteralType (LiteralBoolean b) = "validation.validate_literal(" <> tshow b <> ")"
validatorForComplexType :: ComplexTypeValue -> Text
validatorForComplexType (PointerType fieldType) = validatorForFieldType fieldType
validatorForComplexType (ArrayType _size fieldType) =
mconcat ["validation.validate_list(", validatorForFieldType fieldType, ")"]
validatorForComplexType (SliceType fieldType) =
mconcat ["validation.validate_list(", validatorForFieldType fieldType, ")"]
validatorForComplexType (OptionalType fieldType) =
mconcat ["validation.validate_optional(", validatorForFieldType fieldType, ")"]
decoderForDefinitionReference :: DefinitionReference -> Text
decoderForDefinitionReference
( DefinitionReference
(TypeDefinition (DefinitionName name) _typeData)
) =
name <> ".validate"
decoderForDefinitionReference
( ImportedDefinitionReference
(ModuleName moduleName)
(TypeDefinition (DefinitionName name) _typeData)
) =
mconcat [moduleName, ".", name, ".validate"]
decoderForDefinitionReference
( AppliedGenericReference
appliedTypes
(TypeDefinition (DefinitionName name) _typeData)
) =
let appliedDecoders = appliedTypes & fmap validatorForFieldType & Text.intercalate " "
in mconcat [name, ".validate(", appliedDecoders, ")"]
decoderForDefinitionReference
( AppliedImportedGenericReference
(ModuleName moduleName)
(AppliedTypes appliedTypes)
(TypeDefinition (DefinitionName name) _typeData)
) =
let appliedDecoders = appliedTypes & fmap validatorForFieldType & Text.intercalate " "
in mconcat [moduleName, ".", name, ".validate(", appliedDecoders, ")"]
decoderForDefinitionReference
( GenericDeclarationReference
(ModuleName moduleName)
(DefinitionName name)
(AppliedTypes appliedTypes)
) =
let appliedDecoders = appliedTypes & fmap validatorForFieldType & Text.intercalate " "
in mconcat [moduleName, ".", name, ".validate(", appliedDecoders, ")"]
decoderForDefinitionReference
(DeclarationReference (ModuleName moduleName) (DefinitionName name)) =
mconcat [moduleName, ".", name, ".validate"]
outputUnion :: Text -> FieldName -> UnionType -> Text
outputUnion name typeTag unionType =
let baseClassOutput = outputUnionBaseClass name typeTag (constructorsFrom unionType) typeVariables
casesOutput = outputUnionCases fullUnionName typeVariables typeTag (constructorsFrom unionType)
fullUnionName =
if null typeVariables
then name
else mconcat [name, joinTypeVariables typeVariables]
constructorsFrom (PlainUnion constructors) = constructors
constructorsFrom (GenericUnion _typeVariables constructors) = constructors
typeVariables = case unionType of
PlainUnion _constructors -> []
GenericUnion ts _constructors -> ts
maybeTypeVariableOutput =
if null typeVariables
then ""
else
typeVariables
& fmap (\(TypeVariable t) -> mconcat [t, " = typing.TypeVar('", t, "')"])
& Text.intercalate "\n"
& (<> "\n")
in mconcat [maybeTypeVariableOutput, baseClassOutput, "\n\n", casesOutput]
outputUnionBaseClass :: Text -> FieldName -> [Constructor] -> [TypeVariable] -> Text
outputUnionBaseClass name tag constructors typeVariables =
let validatorOutput = outputUnionValidator name tag constructors typeVariables
decoderOutput = outputUnionDecoder name typeVariables
maybeGenericNotation =
if null typeVariables
then ""
else mconcat ["(typing.Generic", joinTypeVariables typeVariables, ")"]
maybeTypeVariableToJSONArguments =
if null typeVariables
then ""
else
mconcat
[ ", ",
typeVariables
& fmap (\(TypeVariable t) -> mconcat [t, "_to_json: encoding.ToJSON[", t, "]"])
& Text.intercalate ","
]
stubsOutput =
mconcat
[ " def to_json(self",
maybeTypeVariableToJSONArguments,
") -> typing.Dict[str, typing.Any]:\n",
mconcat
[ " raise NotImplementedError('`to_json` is not implemented for base class `",
name,
"`')\n\n"
],
" def encode(self) -> str:\n",
mconcat
[ " raise NotImplementedError('`encode` is not implemented for base class `",
name,
"`')"
]
]
in mconcat
[ mconcat ["class ", name, maybeGenericNotation, ":\n"],
validatorOutput,
"\n\n",
decoderOutput,
"\n\n",
stubsOutput
]
outputUnionValidator :: Text -> FieldName -> [Constructor] -> [TypeVariable] -> Text
outputUnionValidator name (FieldName tag) constructors typeVariables =
let taggedValidators =
constructors
& fmap
( \(Constructor (ConstructorName constructorName) maybePayload) ->
let payloadTypeVariables =
fromMaybe [] $ foldMap typeVariablesFrom maybePayload
maybeTypeVariableValidatorArguments =
if null payloadTypeVariables
then ""
else
mconcat
[ "(",
payloadTypeVariables
& fmap (\(TypeVariable t) -> "validate_" <> t)
& Text.intercalate
", ",
")"
]
in mconcat
[ "'",
constructorName,
"': ",
upperCaseFirstCharacter constructorName,
".validate",
maybeTypeVariableValidatorArguments
]
)
& Text.intercalate ", "
interface = "{" <> taggedValidators <> "}"
functionHead [] =
mconcat [" def validate(value: validation.Unknown) -> validation.ValidationResult['", name, "']:\n"]
functionHead typeVariables' =
mconcat
[ " def validate(",
typeVariableValidatorsAsArguments typeVariables',
") -> validation.Validator['",
fullName,
"']:\n"
]
functionBody [] =
mconcat [" return validation.validate_with_type_tags(value, '", tag, "', ", interface, ")"]
functionBody typeVariables' =
let validatorName =
"validate_" <> name <> (typeVariables' & fmap (\(TypeVariable t) -> t) & mconcat)
in mconcat
[ mconcat
[ " def ",
validatorName,
"(value: validation.Unknown) -> validation.ValidationResult['",
fullName,
"']:\n"
],
mconcat
[ " return validation.validate_with_type_tags(value, '",
tag,
"', ",
interface,
")\n"
],
mconcat [" return ", validatorName]
]
fullName =
if null typeVariables
then name
else mconcat [name, joinTypeVariables typeVariables]
in mconcat
[ " @staticmethod\n",
functionHead typeVariables,
functionBody typeVariables
]
outputUnionDecoder :: Text -> [TypeVariable] -> Text
outputUnionDecoder unionName typeVariables =
let maybeTypeVariableValidatorArguments =
if null typeVariables
then ""
else
mconcat
[ ", ",
typeVariables
& fmap
( \(TypeVariable t) ->
mconcat
[ "validate_" <> t,
": validation.Validator[",
t,
"]"
]
)
& Text.intercalate
", "
]
maybePassedInValidators =
if null typeVariables
then ""
else
mconcat
[ "(",
typeVariables
& fmap (\(TypeVariable t) -> "validate_" <> t)
& Text.intercalate ", ",
")"
]
fullName =
if null typeVariables
then unionName
else mconcat [unionName, joinTypeVariables typeVariables]
in mconcat
[ " @staticmethod\n",
mconcat
[ " def decode(string: typing.Union[str, bytes]",
maybeTypeVariableValidatorArguments,
") -> validation.ValidationResult['",
fullName,
"']:\n"
],
mconcat
[ " return validation.validate_from_string(string, ",
unionName,
".validate",
maybePassedInValidators,
")"
]
]
outputUnionCases :: Text -> [TypeVariable] -> FieldName -> [Constructor] -> Text
outputUnionCases unionName unionTypeVariables tag =
fmap (outputUnionCase unionName unionTypeVariables tag) >>> Text.intercalate "\n\n"
outputUnionCase :: Text -> [TypeVariable] -> FieldName -> Constructor -> Text
outputUnionCase
unionName
unionTypeVariables
fieldName@(FieldName tag)
constructor@(Constructor (ConstructorName name) maybePayload) =
let payloadTypeVariables =
fromMaybe [] $ foldMap typeVariablesFrom maybePayload
fullName =
if null payloadTypeVariables
then name
else mconcat [name, joinTypeVariables payloadTypeVariables]
maybeDataField =
maybePayload & maybe "" (outputFieldType >>> (" data: " <>) >>> (<> "\n\n"))
interface =
mconcat ["{", maybePayload & maybe "" (validatorForFieldType >>> ("'data': " <>)), "}"]
validatorOutput =
mconcat
[ " @staticmethod\n",
validatorFunctionHead payloadTypeVariables,
validatorFunctionBody payloadTypeVariables
]
validatorFunctionHead [] =
mconcat [" def validate(value: validation.Unknown) -> validation.ValidationResult['", name, "']:\n"]
validatorFunctionHead typeVariables =
mconcat
[ " def validate(",
typeVariableValidatorsAsArguments typeVariables,
") -> validation.Validator['",
fullName,
"']:\n"
]
validatorFunctionBody [] =
mconcat
[ " return validation.validate_with_type_tag(value, '",
tag,
"', '",
name,
"', ",
interface,
", ",
name,
")"
]
validatorFunctionBody typeVariables =
let validatorName =
"validate_" <> name <> (typeVariables & fmap (\(TypeVariable t) -> t) & mconcat)
in mconcat
[ mconcat
[ " def ",
validatorName,
"(value: validation.Unknown) -> validation.ValidationResult['",
fullName,
"']:\n"
],
mconcat
[ " return validation.validate_with_type_tag(value, '",
tag,
"', '",
name,
"', ",
interface,
", ",
name,
")\n"
],
mconcat [" return ", validatorName]
]
decoderOutput =
let maybeTypeVariableValidatorArguments =
if null payloadTypeVariables
then ""
else
mconcat
[ ", ",
payloadTypeVariables
& fmap (\(TypeVariable t) -> mconcat ["validate_" <> t, ": validation.Validator[", t, "]"])
& Text.intercalate ", "
]
maybePassedInValidators =
if null payloadTypeVariables
then ""
else
mconcat
[ "(",
payloadTypeVariables
& fmap (\(TypeVariable t) -> "validate_" <> t)
& Text.intercalate ", ",
")"
]
in mconcat
[ " @staticmethod\n",
mconcat
[ " def decode(string: typing.Union[str, bytes]",
maybeTypeVariableValidatorArguments,
") -> validation.ValidationResult['",
fullName,
"']:\n"
],
mconcat
[ " return validation.validate_from_string(string, ",
name,
".validate",
maybePassedInValidators,
")"
]
]
encoderOutput = outputEncoderForUnionConstructor unionTypeVariables fieldName constructor
in mconcat
[ "@dataclass(frozen=True)\n",
mconcat ["class ", name, "(", unionName, "):\n"],
maybeDataField,
validatorOutput,
"\n\n",
decoderOutput,
"\n\n",
encoderOutput
]
outputEncoderForUnionConstructor :: [TypeVariable] -> FieldName -> Constructor -> Text
outputEncoderForUnionConstructor
unionTypeVariables
(FieldName tag)
(Constructor (ConstructorName name) maybePayload) =
let maybeDataField =
maybe "" (dataEncoder >>> (", 'data': " <>)) maybePayload
dataEncoder (BasicType _) = "self.data"
dataEncoder (DefinitionReferenceType _) =
mconcat ["self.data.to_json(", maybePassedInToJSONs, ")"]
dataEncoder fieldType = mconcat [encoderForFieldType ("", "") fieldType, "(self.data)"]
maybeTypeVariableToJSONArguments =
if null unionTypeVariables
then ""
else
mconcat
[ ", ",
unionTypeVariables
& fmap
( \(TypeVariable t) ->
mconcat [t, "_to_json: encoding.ToJSON[", t, "]"]
)
& Text.intercalate ", "
]
interface = mconcat ["{", mconcat ["'", tag, "': '", name, "'", maybeDataField], "}"]
maybePassedInToJSONs =
if null unionTypeVariables
then ""
else
unionTypeVariables
& fmap (\(TypeVariable t) -> t <> "_to_json")
& Text.intercalate ", "
in mconcat
[ mconcat [" def to_json(self", maybeTypeVariableToJSONArguments, ") -> typing.Dict[str, typing.Any]:\n"],
mconcat [" return ", interface, "\n\n"],
mconcat [" def encode(self", maybeTypeVariableToJSONArguments, ") -> str:\n"],
mconcat [" return json.dumps(self.to_json(", maybePassedInToJSONs, "))"]
]
typeVariableValidatorsAsArguments :: [TypeVariable] -> Text
typeVariableValidatorsAsArguments [] = ""
typeVariableValidatorsAsArguments typeVariables =
let types = fmap (\(TypeVariable t) -> mconcat ["validation.Validator[", t, "]"]) typeVariables
in typeVariables
& validatorsForTypeVariables
& zip types
& fmap (\(t, v) -> v <> ": " <> t)
& Text.intercalate ", "
validatorsForTypeVariables :: [TypeVariable] -> [Text]
validatorsForTypeVariables = fmap (TypeVariableReferenceType >>> validatorForFieldType)
typeVariablesFrom :: FieldType -> Maybe [TypeVariable]
typeVariablesFrom (TypeVariableReferenceType typeVariable) = pure [typeVariable]
typeVariablesFrom (ComplexType (ArrayType _size fieldType)) = typeVariablesFrom fieldType
typeVariablesFrom (ComplexType (SliceType fieldType)) = typeVariablesFrom fieldType
typeVariablesFrom (ComplexType (PointerType fieldType)) = typeVariablesFrom fieldType
typeVariablesFrom (ComplexType (OptionalType fieldType)) = typeVariablesFrom fieldType
typeVariablesFrom (RecursiveReferenceType _name) = Nothing
typeVariablesFrom (LiteralType _) = Nothing
typeVariablesFrom (BasicType _) = Nothing
typeVariablesFrom (DefinitionReferenceType definitionReference) =
typeVariablesFromReference definitionReference
typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable]
typeVariablesFromReference (DefinitionReference definition) = typeVariablesFromDefinition definition
typeVariablesFromReference (ImportedDefinitionReference _moduleName definition) =
typeVariablesFromDefinition definition
typeVariablesFromReference (AppliedGenericReference fieldTypes _definition) =
let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join
in if null typeVariables then Nothing else Just typeVariables
typeVariablesFromReference
( AppliedImportedGenericReference
_moduleName
(AppliedTypes fieldTypes)
_definition
) =
let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join
in if null typeVariables then Nothing else Just typeVariables
typeVariablesFromReference
( GenericDeclarationReference
_moduleName
_definitionName
(AppliedTypes fieldTypes)
) =
let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join
in if null typeVariables then Nothing else Just typeVariables
typeVariablesFromReference (DeclarationReference _moduleName _definitionName) =
Nothing
typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable]
typeVariablesFromDefinition (TypeDefinition _name (Struct (PlainStruct _))) = Nothing
typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (PlainUnion _))) = Nothing
typeVariablesFromDefinition (TypeDefinition _name (UntaggedUnion _)) = Nothing
typeVariablesFromDefinition (TypeDefinition _name (Enumeration _)) = Nothing
typeVariablesFromDefinition (TypeDefinition _name (EmbeddedUnion _tagType _constructors)) = Nothing
typeVariablesFromDefinition (TypeDefinition _name (Struct (GenericStruct typeVariables _))) =
pure typeVariables
typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (GenericUnion typeVariables _))) =
pure typeVariables
typeVariablesFromDefinition (TypeDefinition _name (DeclaredType _moduleName typeVariables)) =
pure typeVariables
outputField :: Int -> StructField -> Text
outputField indentation (StructField (FieldName name) fieldType) =
let indent = Text.pack $ replicate indentation ' '
in indent <> mconcat [name, ": ", outputFieldType fieldType]
outputFieldType :: FieldType -> Text
outputFieldType (LiteralType (LiteralString text)) = "typing.Literal['" <> text <> "']"
outputFieldType (LiteralType (LiteralInteger x)) = "typing.Literal['" <> tshow x <> "']"
outputFieldType (LiteralType (LiteralFloat f)) = "typing.Literal['" <> tshow f <> "']"
outputFieldType (LiteralType (LiteralBoolean b)) = "typing.Literal['" <> tshow b <> "']"
outputFieldType (BasicType basicType) = outputBasicType basicType
outputFieldType (ComplexType (OptionalType fieldType)) =
mconcat ["typing.Optional[", outputFieldType fieldType, "]"]
outputFieldType (ComplexType (ArrayType _size fieldType)) =
mconcat ["typing.List[", outputFieldType fieldType, "]"]
outputFieldType (ComplexType (SliceType fieldType)) =
mconcat ["typing.List[", outputFieldType fieldType, "]"]
outputFieldType (ComplexType (PointerType fieldType)) = outputFieldType fieldType
outputFieldType (RecursiveReferenceType (DefinitionName name)) = name
outputFieldType (DefinitionReferenceType definitionReference) =
outputDefinitionReference definitionReference
outputFieldType (TypeVariableReferenceType (TypeVariable t)) = t
outputDefinitionReference :: DefinitionReference -> Text
outputDefinitionReference (DefinitionReference (TypeDefinition (DefinitionName name) _)) = name
outputDefinitionReference
( ImportedDefinitionReference
(ModuleName moduleName)
(TypeDefinition (DefinitionName name) _typeData)
) =
mconcat [moduleName, ".", name]
outputDefinitionReference
( AppliedGenericReference
appliedTypes
(TypeDefinition (DefinitionName name) _)
) =
let appliedFieldTypes = appliedTypes & fmap outputFieldType & Text.intercalate ", "
in mconcat [name, "[", appliedFieldTypes, "]"]
outputDefinitionReference
( AppliedImportedGenericReference
(ModuleName moduleName)
(AppliedTypes appliedTypes)
(TypeDefinition (DefinitionName name) _)
) =
let appliedFieldTypes = appliedTypes & fmap outputFieldType & Text.intercalate ", "
in mconcat [moduleName, ".", name, "[", appliedFieldTypes, "]"]
outputDefinitionReference
( GenericDeclarationReference
(ModuleName moduleName)
(DefinitionName name)
(AppliedTypes appliedTypes)
) =
let appliedFieldTypes = appliedTypes & fmap outputFieldType & Text.intercalate ", "
maybeAppliedOutput = if null appliedTypes then "" else mconcat ["[", appliedFieldTypes, "]"]
in mconcat [moduleName, ".", name, maybeAppliedOutput]
outputDefinitionReference (DeclarationReference (ModuleName moduleName) (DefinitionName name)) =
mconcat [moduleName, ".", name]
outputBasicType :: BasicTypeValue -> Text
outputBasicType BasicString = "str"
outputBasicType U8 = "int"
outputBasicType U16 = "int"
outputBasicType U32 = "int"
outputBasicType U64 = "int"
outputBasicType U128 = "int"
outputBasicType I8 = "int"
outputBasicType I16 = "int"
outputBasicType I32 = "int"
outputBasicType I64 = "int"
outputBasicType I128 = "int"
outputBasicType F32 = "float"
outputBasicType F64 = "float"
outputBasicType Boolean = "bool"
fieldTypeName :: FieldType -> Text
fieldTypeName (LiteralType _) = error "Just don't use literals in untagged unions"
fieldTypeName (RecursiveReferenceType _) =
error "Just don't use recursive references in untagged unions"
fieldTypeName (BasicType BasicString) = "str"
fieldTypeName (BasicType F32) = "float"
fieldTypeName (BasicType F64) = "float"
fieldTypeName (BasicType U8) = "int"
fieldTypeName (BasicType U16) = "int"
fieldTypeName (BasicType U32) = "int"
fieldTypeName (BasicType U64) = "int"
fieldTypeName (BasicType U128) = "int"
fieldTypeName (BasicType I8) = "int"
fieldTypeName (BasicType I16) = "int"
fieldTypeName (BasicType I32) = "int"
fieldTypeName (BasicType I64) = "int"
fieldTypeName (BasicType I128) = "int"
fieldTypeName (BasicType Boolean) = "bool"
fieldTypeName (TypeVariableReferenceType (TypeVariable t)) = t
fieldTypeName (ComplexType (ArrayType _ _arrayFieldType)) = "list"
fieldTypeName (ComplexType (SliceType _sliceFieldType)) = "list"
fieldTypeName (ComplexType (PointerType pointerFieldType)) = fieldTypeName pointerFieldType
fieldTypeName (ComplexType (OptionalType optionalFieldType)) = fieldTypeName optionalFieldType
fieldTypeName
( DefinitionReferenceType
(DefinitionReference (TypeDefinition (DefinitionName definitionName) _))
) =
definitionName
fieldTypeName
( DefinitionReferenceType
(ImportedDefinitionReference _ (TypeDefinition (DefinitionName definitionName) _))
) =
definitionName
fieldTypeName
( DefinitionReferenceType
( AppliedGenericReference
_fieldTypes
(TypeDefinition (DefinitionName definitionName) _)
)
) =
definitionName
fieldTypeName
( DefinitionReferenceType
( AppliedImportedGenericReference
_moduleName
(AppliedTypes _fieldTypes)
(TypeDefinition (DefinitionName definitionName) _)
)
) =
definitionName
fieldTypeName
( DefinitionReferenceType
( GenericDeclarationReference
(ModuleName _moduleName)
(DefinitionName definitionName)
(AppliedTypes _fieldTypes)
)
) =
definitionName
fieldTypeName
(DefinitionReferenceType (DeclarationReference _moduleName (DefinitionName definitionName))) =
definitionName
joinTypeVariables :: [TypeVariable] -> Text
joinTypeVariables typeVariables =
typeVariables
& fmap (\(TypeVariable t) -> t)
& Text.intercalate ", "
& (\o -> "[" <> o <> "]")
nameOfReference :: DefinitionReference -> DefinitionName
nameOfReference (DefinitionReference (TypeDefinition name _)) = name
nameOfReference (ImportedDefinitionReference _moduleName (TypeDefinition name _)) = name
nameOfReference (AppliedGenericReference _fieldTypes (TypeDefinition name _)) = name
nameOfReference (AppliedImportedGenericReference _moduleName _fieldTypes (TypeDefinition name _)) =
name
nameOfReference (GenericDeclarationReference _moduleName name _fieldTypes) = name
nameOfReference (DeclarationReference _moduleName name) = name