module CodeGeneration.Python (outputModule) where

import CodeGeneration.Utilities (upperCaseFirstCharacter)
import RIO
import qualified RIO.Text as Text
import Types

outputModule :: Module -> Text
outputModule :: Module -> Text
outputModule Module {[TypeDefinition]
$sel:definitions:Module :: Module -> [TypeDefinition]
definitions :: [TypeDefinition]
definitions, [Import]
$sel:imports:Module :: Module -> [Import]
imports :: [Import]
imports, [ModuleName]
$sel:declarationNames:Module :: Module -> [ModuleName]
declarationNames :: [ModuleName]
declarationNames} =
  let definitionOutput :: Text
definitionOutput = [TypeDefinition]
definitions [TypeDefinition] -> ([TypeDefinition] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeDefinition -> Maybe Text) -> [TypeDefinition] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TypeDefinition -> Maybe Text
outputDefinition [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n\n"
      importsOutput :: Text
importsOutput = [Import]
imports [Import] -> ([Import] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Import -> Text) -> [Import] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Import -> Text
outputImport [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n"
      outputImport :: Import -> Text
outputImport (Import Module {$sel:name:Module :: Module -> ModuleName
name = ModuleName Text
importName}) =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"from . import ", Text
importName]
      declarationImportsOutput :: Text
declarationImportsOutput =
        [ModuleName]
declarationNames
          [ModuleName] -> ([ModuleName] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (ModuleName -> Text) -> [ModuleName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \(ModuleName Text
name) ->
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"from . import ", Text
name]
            )
          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n"
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"import json\n",
              Text
"import typing\n",
              Text
"from dataclasses import dataclass\n",
              Text
"from gotyno_validation import validation\n",
              Text
"from gotyno_validation import encoding\n\n"
            ],
          Text
importsOutput,
          if [Import] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Import]
imports then Text
"" else Text
"\n\n",
          Text
declarationImportsOutput,
          if [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
declarationNames then Text
"" else Text
"\n\n",
          Text
definitionOutput
        ]

outputDefinition :: TypeDefinition -> Maybe Text
outputDefinition :: TypeDefinition -> Maybe Text
outputDefinition (TypeDefinition (DefinitionName Text
name) (Struct (PlainStruct [StructField]
fields))) =
  Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [StructField] -> Text
outputPlainStruct Text
name [StructField]
fields
outputDefinition (TypeDefinition (DefinitionName Text
name) (Struct (GenericStruct [TypeVariable]
typeVariables [StructField]
fields))) =
  Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [TypeVariable] -> [StructField] -> Text
outputGenericStruct Text
name [TypeVariable]
typeVariables [StructField]
fields
outputDefinition (TypeDefinition (DefinitionName Text
name) (Union FieldName
typeTag UnionType
unionType)) =
  Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> FieldName -> UnionType -> Text
outputUnion Text
name FieldName
typeTag UnionType
unionType
outputDefinition (TypeDefinition (DefinitionName Text
name) (Enumeration [EnumerationValue]
enumerationValues)) =
  Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [EnumerationValue] -> Text
outputEnumeration Text
name [EnumerationValue]
enumerationValues
outputDefinition (TypeDefinition (DefinitionName Text
name) (UntaggedUnion [FieldType]
unionCases)) =
  Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [FieldType] -> Text
outputUntaggedUnion Text
name [FieldType]
unionCases
outputDefinition (TypeDefinition (DefinitionName Text
name) (EmbeddedUnion FieldName
typeTag [EmbeddedConstructor]
constructors)) =
  Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedUnion Text
name FieldName
typeTag [EmbeddedConstructor]
constructors
outputDefinition (TypeDefinition DefinitionName
_name (DeclaredType ModuleName
_moduleName [TypeVariable]
_typeVariables)) = Maybe Text
forall a. Maybe a
Nothing

outputEmbeddedUnion :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedUnion :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedUnion Text
unionName FieldName
fieldName [EmbeddedConstructor]
constructors =
  let baseClassOutput :: Text
baseClassOutput =
        Text -> FieldName -> [Constructor] -> [TypeVariable] -> Text
outputUnionBaseClass
          Text
unionName
          FieldName
fieldName
          ([EmbeddedConstructor] -> [Constructor]
embeddedConstructorsToConstructors [EmbeddedConstructor]
constructors)
          []
      casesOutput :: Text
casesOutput = Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedUnionCases Text
unionName FieldName
fieldName [EmbeddedConstructor]
constructors
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
baseClassOutput, Text
"\n\n", Text
casesOutput]

outputEmbeddedUnionCases :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedUnionCases :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedUnionCases Text
unionName FieldName
fieldName =
  (EmbeddedConstructor -> Text) -> [EmbeddedConstructor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedUnionCase Text
unionName FieldName
fieldName) ([EmbeddedConstructor] -> [Text])
-> ([Text] -> Text) -> [EmbeddedConstructor] -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> [Text] -> Text
Text.intercalate Text
"\n\n"

outputEmbeddedUnionCase :: Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedUnionCase :: Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedUnionCase
  Text
unionName
  FieldName
tag
  constructor :: EmbeddedConstructor
constructor@(EmbeddedConstructor (ConstructorName Text
name) Maybe DefinitionReference
Nothing) =
    let validatorOutput :: Text
validatorOutput = FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorDecoder FieldName
tag EmbeddedConstructor
constructor
        encoderOutput :: Text
encoderOutput = FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorEncoder FieldName
tag EmbeddedConstructor
constructor
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"@dataclass\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"class ", Text -> Text
upperCaseFirstCharacter Text
name, Text
"(", Text
unionName, Text
"):\n"],
            Text
validatorOutput,
            Text
"\n\n",
            Text
encoderOutput
          ]
outputEmbeddedUnionCase
  Text
unionName
  FieldName
tag
  constructor :: EmbeddedConstructor
constructor@(EmbeddedConstructor (ConstructorName Text
name) (Just DefinitionReference
reference)) =
    let structFields :: [StructField]
structFields = DefinitionReference -> [StructField]
structFieldsFromReference DefinitionReference
reference
        typesOutput :: Text
typesOutput =
          [StructField]
structFields
            [StructField] -> ([StructField] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (StructField -> Text) -> [StructField] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              ( \(StructField (FieldName Text
n) FieldType
fieldType) ->
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    ", Text
n, Text
": ", FieldType -> Text
outputFieldType FieldType
fieldType]
              )
            [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n"
        validatorOutput :: Text
validatorOutput = FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorDecoder FieldName
tag EmbeddedConstructor
constructor
        encoderOutput :: Text
encoderOutput = FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorEncoder FieldName
tag EmbeddedConstructor
constructor
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"@dataclass\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"class ", Text -> Text
upperCaseFirstCharacter Text
name, Text
"(", Text
unionName, Text
"):\n"],
            Text
typesOutput,
            Text
"\n\n",
            Text
validatorOutput,
            Text
"\n\n",
            Text
encoderOutput
          ]

outputEmbeddedConstructorDecoder :: FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorDecoder :: FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorDecoder
  (FieldName Text
tag)
  (EmbeddedConstructor (ConstructorName Text
name) Maybe DefinitionReference
Nothing) =
    let typeName :: Text
typeName = Text -> Text
upperCaseFirstCharacter Text
name
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"    @staticmethod\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    def validate(value: validation.Unknown) -> validation.ValidationResult['", Text
typeName, Text
"']:\n"],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"        return validation.validate_with_type_tag_and_validator(value, '",
                Text
tag,
                Text
"', '",
                Text
name,
                Text
"', validation.validate_unknown, ",
                Text
typeName,
                Text
")\n\n"
              ],
            Text
"    @staticmethod\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"    def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
                Text
typeName,
                Text
"']:\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return validation.validate_from_string(string, ", Text
typeName, Text
".validate)"]
          ]
outputEmbeddedConstructorDecoder
  (FieldName Text
tag)
  (EmbeddedConstructor (ConstructorName Text
name) (Just DefinitionReference
reference)) =
    let typeName :: Text
typeName = Text -> Text
upperCaseFirstCharacter Text
name
        DefinitionName Text
referenceName = DefinitionReference -> DefinitionName
nameOfReference DefinitionReference
reference
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"    @staticmethod\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    def validate(value: validation.Unknown) -> validation.ValidationResult['", Text
typeName, Text
"']:\n"],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"        return validation.validate_with_type_tag_and_validator(value, '",
                Text
tag,
                Text
"', '",
                Text
name,
                Text
"', ",
                Text
referenceName,
                Text
".validate, ",
                Text
typeName,
                Text
")\n\n"
              ],
            Text
"    @staticmethod\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"    def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
                Text
typeName,
                Text
"']:\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return validation.validate_from_string(string, ", Text
typeName, Text
".validate)"]
          ]

outputEmbeddedConstructorEncoder :: FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorEncoder :: FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorEncoder
  (FieldName Text
tag)
  (EmbeddedConstructor (ConstructorName Text
name) Maybe DefinitionReference
Nothing) =
    let interface :: Text
interface = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"{'", Text
tag, Text
"': '", Text
name, Text
"'}"]
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"    def to_json(self) -> typing.Dict[str, typing.Any]:\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return ", Text
interface, Text
"\n\n"],
            Text
"    def encode(self) -> str:\n",
            Text
"        return json.dumps(self.to_json())"
          ]
outputEmbeddedConstructorEncoder
  (FieldName Text
tag)
  (EmbeddedConstructor (ConstructorName Text
name) (Just DefinitionReference
reference)) =
    let DefinitionName Text
referenceName = DefinitionReference -> DefinitionName
nameOfReference DefinitionReference
reference
        interface :: Text
interface = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"{'", Text
tag, Text
"': '", Text
name, Text
"', **", Text
referenceName, Text
".to_json(self)}"]
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"    def to_json(self) -> typing.Dict[str, typing.Any]:\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return ", Text
interface, Text
"\n\n"],
            Text
"    def encode(self) -> str:\n",
            Text
"        return json.dumps(self.to_json())"
          ]

structFieldsFromReference :: DefinitionReference -> [StructField]
structFieldsFromReference :: DefinitionReference -> [StructField]
structFieldsFromReference
  (DefinitionReference (TypeDefinition DefinitionName
_name (Struct (PlainStruct [StructField]
fields)))) = [StructField]
fields
structFieldsFromReference DefinitionReference
_other = [Char] -> [StructField]
forall a. HasCallStack => [Char] -> a
error [Char]
"struct fields from anything other than plain struct"

embeddedConstructorsToConstructors :: [EmbeddedConstructor] -> [Constructor]
embeddedConstructorsToConstructors :: [EmbeddedConstructor] -> [Constructor]
embeddedConstructorsToConstructors = (EmbeddedConstructor -> Constructor)
-> [EmbeddedConstructor] -> [Constructor]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EmbeddedConstructor -> Constructor
embeddedConstructorToConstructor

embeddedConstructorToConstructor :: EmbeddedConstructor -> Constructor
embeddedConstructorToConstructor :: EmbeddedConstructor -> Constructor
embeddedConstructorToConstructor (EmbeddedConstructor ConstructorName
name Maybe DefinitionReference
reference) =
  ConstructorName -> Maybe FieldType -> Constructor
Constructor ConstructorName
name (DefinitionReference -> FieldType
DefinitionReferenceType (DefinitionReference -> FieldType)
-> Maybe DefinitionReference -> Maybe FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DefinitionReference
reference)

outputUntaggedUnion :: Text -> [FieldType] -> Text
outputUntaggedUnion :: Text -> [FieldType] -> Text
outputUntaggedUnion Text
unionName [FieldType]
cases =
  let typeOutput :: Text
typeOutput = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
unionName, Text
" = ", Text
"typing.Union[", Text
unionOutput, Text
"]"]
      unionOutput :: Text
unionOutput = [FieldType]
cases [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Text
outputCase [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
      outputCase :: FieldType -> Text
outputCase FieldType
fieldType = FieldType -> Text
outputFieldType FieldType
fieldType
      interfaceOutput :: Text
interfaceOutput = Text -> [FieldType] -> Text
outputUntaggedUnionInterface Text
unionName [FieldType]
cases
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
typeOutput, Text
"\n", Text
interfaceOutput]

outputUntaggedUnionInterface :: Text -> [FieldType] -> Text
outputUntaggedUnionInterface :: Text -> [FieldType] -> Text
outputUntaggedUnionInterface Text
unionName [FieldType]
cases =
  let oneOfValidatorsOutput :: Text
oneOfValidatorsOutput =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"[",
            [FieldType]
cases
              [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Text
validatorForFieldType
              [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", ",
            Text
"]"
          ]
      oneOfToJSONInterface :: Text
oneOfToJSONInterface =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"{",
            [FieldType]
cases
              [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                ( \FieldType
fieldType ->
                    FieldType -> Text
fieldTypeName FieldType
fieldType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"") FieldType
fieldType
                )
              [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", ",
            Text
"}"
          ]
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"class ", Text
unionName, Text
"Interface:\n"],
          Text
"    @staticmethod\n",
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"    def validate(value: validation.Unknown) -> validation.ValidationResult['",
              Text
unionName,
              Text
"']:\n"
            ],
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"        return validation.validate_one_of(value, ",
              Text
oneOfValidatorsOutput,
              Text
")\n\n"
            ],
          Text
"    @staticmethod\n",
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"    def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
              Text
unionName,
              Text
"']:\n"
            ],
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"        return validation.validate_from_string(string, ",
              Text
unionName,
              Text
"Interface.validate)\n\n"
            ],
          Text
"    @staticmethod\n",
          Text
"    def to_json(value) -> typing.Any:\n",
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [Text
"        return encoding.one_of_to_json(value, ", Text
oneOfToJSONInterface, Text
")\n\n"],
          Text
"    @staticmethod\n",
          Text
"    def encode(value) -> str:\n",
          Text
"        return json.dumps(value.to_json())"
        ]

outputEnumeration :: Text -> [EnumerationValue] -> Text
outputEnumeration :: Text -> [EnumerationValue] -> Text
outputEnumeration Text
name [EnumerationValue]
values =
  let typeOutput :: Text
typeOutput = Text -> [EnumerationValue] -> Text
outputEnumerationType Text
name [EnumerationValue]
values
      validatorOutput :: Text
validatorOutput = Text -> Text
outputEnumerationValidator Text
name
      decoderOutput :: Text
decoderOutput = Text -> Text
outputEnumerationDecoder Text
name
      encoderOutput :: Text
encoderOutput = Text
outputEnumerationEncoder
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
typeOutput, Text
"\n\n", Text
validatorOutput, Text
"\n\n", Text
decoderOutput, Text
"\n\n", Text
encoderOutput]

outputEnumerationType :: Text -> [EnumerationValue] -> Text
outputEnumerationType :: Text -> [EnumerationValue] -> Text
outputEnumerationType Text
name [EnumerationValue]
values =
  let valuesOutput :: Text
valuesOutput =
        [EnumerationValue]
values
          [EnumerationValue] -> ([EnumerationValue] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (EnumerationValue -> Text) -> [EnumerationValue] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \(EnumerationValue (EnumerationIdentifier Text
i) LiteralTypeValue
literal) ->
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    ", Text
i, Text
" = ", LiteralTypeValue -> Text
literalValue LiteralTypeValue
literal]
            )
          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n"
      literalValue :: LiteralTypeValue -> Text
literalValue (LiteralString Text
s) = Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
      literalValue (LiteralInteger Integer
i) = Integer -> Text
forall a. Show a => a -> Text
tshow Integer
i
      literalValue (LiteralFloat Float
f) = Float -> Text
forall a. Show a => a -> Text
tshow Float
f
      literalValue (LiteralBoolean Bool
b) = Bool -> Text
forall a. Show a => a -> Text
tshow Bool
b
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"class ", Text
name, Text
"(enum.Enum):\n"], Text
valuesOutput]

outputEnumerationValidator :: Text -> Text
outputEnumerationValidator :: Text -> Text
outputEnumerationValidator Text
name =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"    @staticmethod\n",
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"    def validate(value: validation.Unknown) -> validation.ValidationResult['",
          Text
name,
          Text
"']:\n"
        ],
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return validation.validate_enumeration_member(value, ", Text
name, Text
")"]
    ]

outputEnumerationDecoder :: Text -> Text
outputEnumerationDecoder :: Text -> Text
outputEnumerationDecoder Text
name =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"    @staticmethod\n",
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"    def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
          Text
name,
          Text
"']:\n"
        ],
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return validation.validate_from_string(string, ", Text
name, Text
".validate)"]
    ]

outputEnumerationEncoder :: Text
outputEnumerationEncoder :: Text
outputEnumerationEncoder =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"    def to_json(self) -> typing.Any:\n",
      Text
"        return self.value\n\n",
      Text
"    def encode(self) -> str:\n",
      Text
"        return str(self.value)"
    ]

outputPlainStruct :: Text -> [StructField] -> Text
outputPlainStruct :: Text -> [StructField] -> Text
outputPlainStruct Text
name [StructField]
fields =
  let fieldsOutput :: Text
fieldsOutput = [StructField]
fields [StructField] -> ([StructField] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (StructField -> Text) -> [StructField] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> StructField -> Text
outputField Int
4) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n"
      validatorOutput :: Text
validatorOutput = Text -> [StructField] -> [TypeVariable] -> Text
outputStructValidator Text
name [StructField]
fields []
      encoderOutput :: Text
encoderOutput = [StructField] -> [TypeVariable] -> Text
outputStructEncoder [StructField]
fields []
      decoderOutput :: Text
decoderOutput = Text -> [TypeVariable] -> Text
outputStructDecoder Text
name []
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"@dataclass(frozen=True)\nclass ", Text
name, Text
":\n"],
          Text
fieldsOutput,
          Text
"\n\n",
          Text
validatorOutput,
          Text
"\n\n",
          Text
decoderOutput,
          Text
"\n\n",
          Text
encoderOutput
        ]

outputGenericStruct :: Text -> [TypeVariable] -> [StructField] -> Text
outputGenericStruct :: Text -> [TypeVariable] -> [StructField] -> Text
outputGenericStruct Text
name [TypeVariable]
typeVariables [StructField]
fields =
  let fullName :: Text
fullName = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, Text
"(typing.Generic", [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables, Text
")"]
      typeOutput :: Text
typeOutput =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"@dataclass(frozen=True)\nclass ", Text
fullName, Text
":\n"],
            Text
fieldsOutput
          ]
      fieldsOutput :: Text
fieldsOutput = [StructField]
fields [StructField] -> ([StructField] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (StructField -> Text) -> [StructField] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> StructField -> Text
outputField Int
4) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n"
      validatorOutput :: Text
validatorOutput = Text -> [StructField] -> [TypeVariable] -> Text
outputStructValidator Text
name [StructField]
fields [TypeVariable]
typeVariables
      decoderOutput :: Text
decoderOutput = Text -> [TypeVariable] -> Text
outputStructDecoder Text
name [TypeVariable]
typeVariables
      encoderOutput :: Text
encoderOutput = [StructField] -> [TypeVariable] -> Text
outputStructEncoder [StructField]
fields [TypeVariable]
typeVariables
      typeVariableOutput :: Text
typeVariableOutput = [TypeVariable]
typeVariables [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeVariable -> Text
outputTypeVariableDefinition [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n"
      outputTypeVariableDefinition :: TypeVariable -> Text
outputTypeVariableDefinition (TypeVariable Text
t) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
t, Text
" = typing.TypeVar('", Text
t, Text
"')"]
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
typeVariableOutput,
          Text
"\n",
          Text
typeOutput,
          Text
"\n\n",
          Text
validatorOutput,
          Text
"\n\n",
          Text
decoderOutput,
          Text
"\n\n",
          Text
encoderOutput
        ]

outputStructValidator :: Text -> [StructField] -> [TypeVariable] -> Text
outputStructValidator :: Text -> [StructField] -> [TypeVariable] -> Text
outputStructValidator Text
name [StructField]
fields [TypeVariable]
typeVariables =
  let validateFunctionOutput :: Text
validateFunctionOutput =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
plainValidator
          else Text
genericValidator
      fullName :: Text
fullName =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
name
          else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables]
      plainValidator :: Text
plainValidator =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"    def validate(value: validation.Unknown) -> validation.ValidationResult['",
                Text
name,
                Text
"']:\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"        return validation.validate_interface(value, ",
                Text
interface,
                Text
", ",
                Text
name,
                Text
")"
              ]
          ]
      genericValidator :: Text
genericValidator =
        let validatorName :: Text
validatorName =
              [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"validate_",
                  Text
name,
                  [TypeVariable]
typeVariables [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> Text
t) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
""
                ]
         in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ Text
"    def validate(",
                    [TypeVariable] -> Text
typeVariableValidatorsAsArguments [TypeVariable]
typeVariables,
                    Text
") -> validation.Validator['",
                    Text
fullName,
                    Text
"']:\n"
                  ],
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ Text
"        def ",
                    Text
validatorName,
                    Text
"(value: validation.Unknown) -> validation.ValidationResult['",
                    Text
fullName,
                    Text
"']:\n"
                  ],
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ Text
"            return validation.validate_interface(value, ",
                    Text
interface,
                    Text
", ",
                    Text
name,
                    Text
")\n"
                  ],
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return ", Text
validatorName]
              ]
      interface :: Text
interface =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"{", [StructField]
fields [StructField] -> ([StructField] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (StructField -> Text) -> [StructField] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructField -> Text
outputValidatorForField [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", ", Text
"}"]
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    @staticmethod\n", Text
validateFunctionOutput]

outputStructDecoder :: Text -> [TypeVariable] -> Text
outputStructDecoder :: Text -> [TypeVariable] -> Text
outputStructDecoder Text
name [TypeVariable]
typeVariables =
  let decodeFunctionOutput :: Text
decodeFunctionOutput =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
plainDecoder
          else Text
genericDecoder
      fullName :: Text
fullName =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
name
          else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables]
      plainDecoder :: Text
plainDecoder =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ Text
"    def decode(string: typing.Union[str, bytes]) -> validation.ValidationResult['",
                    Text
name,
                    Text
"']:\n"
                  ]
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return validation.validate_from_string(string, ", Text
name, Text
".validate)"]
          ]
      genericDecoder :: Text
genericDecoder =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"    def decode(string: typing.Union[str, bytes], ",
                Text
validatorArguments,
                Text
") -> validation.ValidationResult['",
                Text
fullName,
                Text
"']:\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"        return validation.validate_from_string(string, ",
                Text
name,
                Text
".validate(",
                [TypeVariable]
typeVariables
                  [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeVariable -> FieldType
TypeVariableReferenceType (TypeVariable -> FieldType)
-> (FieldType -> Text) -> TypeVariable -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FieldType -> Text
validatorForFieldType)
                  [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", ",
                Text
"))"
              ]
          ]
      validatorArguments :: Text
validatorArguments =
        [TypeVariable] -> Text
typeVariableValidatorsAsArguments [TypeVariable]
typeVariables
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    @staticmethod\n", Text
decodeFunctionOutput]

outputStructEncoder :: [StructField] -> [TypeVariable] -> Text
outputStructEncoder :: [StructField] -> [TypeVariable] -> Text
outputStructEncoder [StructField]
fields [TypeVariable]
typeVariables =
  let interface :: Text
interface =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [Text
"{", [StructField]
fields [StructField] -> ([StructField] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (StructField -> Text) -> [StructField] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructField -> Text
outputEncoderForField [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", ", Text
"}"]
      maybeTypeVariableToJSONArguments :: Text
maybeTypeVariableToJSONArguments =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
""
          else
            Text
", "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( [TypeVariable]
typeVariables
                     [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                       ( \(TypeVariable Text
t) ->
                           [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
t, Text
"_to_json: encoding.ToJSON[", Text
t, Text
"]"]
                       )
                     [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
                 )
      maybePassedInToJSONs :: Text
maybePassedInToJSONs =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
""
          else [TypeVariable]
typeVariables [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_to_json") [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    def to_json(self", Text
maybeTypeVariableToJSONArguments, Text
") -> typing.Dict[str, typing.Any]:\n"],
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return ", Text
interface, Text
"\n\n"],
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    def encode(self", Text
maybeTypeVariableToJSONArguments, Text
") -> str:\n"],
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return json.dumps(self.to_json(", Text
maybePassedInToJSONs, Text
"))"]
        ]

outputValidatorForField :: StructField -> Text
outputValidatorForField :: StructField -> Text
outputValidatorForField (StructField (FieldName Text
fieldName) FieldType
fieldType) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"'",
      Text
fieldName,
      Text
"': ",
      FieldType -> Text
validatorForFieldType FieldType
fieldType
    ]

outputEncoderForField :: StructField -> Text
outputEncoderForField :: StructField -> Text
outputEncoderForField
  (StructField (FieldName Text
fieldName) fieldType :: FieldType
fieldType@(LiteralType LiteralTypeValue
_)) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"'", Text
fieldName, Text
"': ", (Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"") FieldType
fieldType]
outputEncoderForField
  (StructField (FieldName Text
fieldName) basicType :: FieldType
basicType@(BasicType BasicTypeValue
t))
    | BasicTypeValue
t BasicTypeValue -> [BasicTypeValue] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BasicTypeValue
U64, BasicTypeValue
U128, BasicTypeValue
I64, BasicTypeValue
I128] =
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"'",
          Text
fieldName,
          Text
"': ",
          (Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"") FieldType
basicType,
          Text
"(self.",
          Text
fieldName,
          Text
")"
        ]
    | Bool
otherwise = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"'", Text
fieldName, Text
"': self.", Text
fieldName]
outputEncoderForField
  ( StructField
      (FieldName Text
fieldName)
      (DefinitionReferenceType (AppliedGenericReference [FieldType]
appliedTypeVariables TypeDefinition
_definition))
    ) =
    let passedInToJSONs :: Text
passedInToJSONs =
          [FieldType]
appliedTypeVariables [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"")) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"'", Text
fieldName, Text
"': self.", Text
fieldName, Text
".to_json(", Text
passedInToJSONs, Text
")"]
outputEncoderForField
  ( StructField
      (FieldName Text
fieldName)
      ( DefinitionReferenceType
          ( AppliedImportedGenericReference
              ModuleName
_moduleName
              (AppliedTypes [FieldType]
appliedTypeVariables)
              TypeDefinition
_definition
            )
        )
    ) =
    let passedInToJSONs :: Text
passedInToJSONs =
          [FieldType]
appliedTypeVariables [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"")) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"'", Text
fieldName, Text
"': self.", Text
fieldName, Text
".to_json(", Text
passedInToJSONs, Text
")"]
outputEncoderForField (StructField (FieldName Text
fieldName) FieldType
fieldType) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"'",
      Text
fieldName,
      Text
"': ",
      (Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"") FieldType
fieldType,
      Text
"(self.",
      Text
fieldName,
      Text
")"
    ]

encoderForFieldType :: (Text, Text) -> FieldType -> Text
encoderForFieldType :: (Text, Text) -> FieldType -> Text
encoderForFieldType (Text
_l, Text
_r) (LiteralType LiteralTypeValue
literalType) = LiteralTypeValue -> Text
encoderForLiteralType LiteralTypeValue
literalType
encoderForFieldType (Text
_l, Text
_r) (BasicType BasicTypeValue
basicType) = BasicTypeValue -> Text
encoderForBasicType BasicTypeValue
basicType
encoderForFieldType (Text
l, Text
r) (ComplexType ComplexTypeValue
complexType) = Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComplexTypeValue -> Text
encoderForComplexType ComplexTypeValue
complexType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r
encoderForFieldType (Text
_l, Text
_r) (DefinitionReferenceType DefinitionReference
definitionReference) =
  DefinitionReference -> Text
encoderForDefinitionReference DefinitionReference
definitionReference
encoderForFieldType (Text
_l, Text
_r) (TypeVariableReferenceType (TypeVariable Text
name)) = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_to_json"
encoderForFieldType (Text
_l, Text
_r) (RecursiveReferenceType (DefinitionName Text
name)) = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".to_json"

encoderForBasicType :: BasicTypeValue -> Text
encoderForBasicType :: BasicTypeValue -> Text
encoderForBasicType BasicTypeValue
U64 = Text
"encoding.bigint_to_json"
encoderForBasicType BasicTypeValue
U128 = Text
"encoding.bigint_to_json"
encoderForBasicType BasicTypeValue
I64 = Text
"encoding.bigint_to_json"
encoderForBasicType BasicTypeValue
I128 = Text
"encoding.bigint_to_json"
encoderForBasicType BasicTypeValue
_ = Text
"encoding.basic_to_json"

encoderForLiteralType :: LiteralTypeValue -> Text
encoderForLiteralType :: LiteralTypeValue -> Text
encoderForLiteralType (LiteralString Text
s) = Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
encoderForLiteralType (LiteralInteger Integer
i) = Integer -> Text
forall a. Show a => a -> Text
tshow Integer
i
encoderForLiteralType (LiteralFloat Float
f) = Float -> Text
forall a. Show a => a -> Text
tshow Float
f
encoderForLiteralType (LiteralBoolean Bool
b) = Bool -> Text
forall a. Show a => a -> Text
tshow Bool
b

encoderForComplexType :: ComplexTypeValue -> Text
encoderForComplexType :: ComplexTypeValue -> Text
encoderForComplexType (PointerType FieldType
fieldType) = (Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"") FieldType
fieldType
encoderForComplexType (ArrayType Integer
_size FieldType
fieldType) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"encoding.list_to_json(", (Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"(", Text
")") FieldType
fieldType, Text
")"]
encoderForComplexType (SliceType FieldType
fieldType) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"encoding.list_to_json(", (Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"(", Text
")") FieldType
fieldType, Text
")"]
encoderForComplexType (OptionalType FieldType
fieldType) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"encoding.optional_to_json(", (Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"(", Text
")") FieldType
fieldType, Text
")"]

encoderForDefinitionReference :: DefinitionReference -> Text
encoderForDefinitionReference :: DefinitionReference -> Text
encoderForDefinitionReference
  ( DefinitionReference
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".to_json"
encoderForDefinitionReference
  ( ImportedDefinitionReference
      (ModuleName Text
moduleName)
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
".to_json"]
encoderForDefinitionReference
  ( AppliedGenericReference
      [FieldType]
appliedTypes
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    let appliedEncoders :: Text
appliedEncoders = [FieldType]
appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"")) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
" "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, Text
".to_json(", Text
appliedEncoders, Text
")"]
encoderForDefinitionReference
  ( AppliedImportedGenericReference
      (ModuleName Text
moduleName)
      (AppliedTypes [FieldType]
appliedTypes)
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    let appliedEncoders :: Text
appliedEncoders = [FieldType]
appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"")) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
" "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
".to_json(", Text
appliedEncoders, Text
")"]
encoderForDefinitionReference
  ( GenericDeclarationReference
      (ModuleName Text
moduleName)
      (DefinitionName Text
name)
      (AppliedTypes [FieldType]
appliedTypes)
    ) =
    let appliedEncoders :: Text
appliedEncoders = [FieldType]
appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"")) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
" "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
".to_json(", Text
appliedEncoders, Text
")"]
encoderForDefinitionReference
  (DeclarationReference (ModuleName Text
moduleName) (DefinitionName Text
name)) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
".to_json"]

validatorForFieldType :: FieldType -> Text
validatorForFieldType :: FieldType -> Text
validatorForFieldType (LiteralType LiteralTypeValue
literalType) = LiteralTypeValue -> Text
validatorForLiteralType LiteralTypeValue
literalType
validatorForFieldType (BasicType BasicTypeValue
basicType) = BasicTypeValue -> Text
validatorForBasicType BasicTypeValue
basicType
validatorForFieldType (ComplexType ComplexTypeValue
complexType) = ComplexTypeValue -> Text
validatorForComplexType ComplexTypeValue
complexType
validatorForFieldType (DefinitionReferenceType DefinitionReference
definitionReference) =
  DefinitionReference -> Text
decoderForDefinitionReference DefinitionReference
definitionReference
validatorForFieldType (TypeVariableReferenceType (TypeVariable Text
name)) = Text
"validate_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
validatorForFieldType (RecursiveReferenceType (DefinitionName Text
name)) = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".decode"

validatorForBasicType :: BasicTypeValue -> Text
validatorForBasicType :: BasicTypeValue -> Text
validatorForBasicType BasicTypeValue
BasicString = Text
"validation.validate_string"
validatorForBasicType BasicTypeValue
U8 = Text
"validation.validate_int"
validatorForBasicType BasicTypeValue
U16 = Text
"validation.validate_int"
validatorForBasicType BasicTypeValue
U32 = Text
"validation.validate_int"
validatorForBasicType BasicTypeValue
U64 = Text
"validation.validate_bigint"
validatorForBasicType BasicTypeValue
U128 = Text
"validation.validate_bigint"
validatorForBasicType BasicTypeValue
I8 = Text
"validation.validate_int"
validatorForBasicType BasicTypeValue
I16 = Text
"validation.validate_int"
validatorForBasicType BasicTypeValue
I32 = Text
"validation.validate_int"
validatorForBasicType BasicTypeValue
I64 = Text
"validation.validate_bigint"
validatorForBasicType BasicTypeValue
I128 = Text
"validation.validate_bigint"
validatorForBasicType BasicTypeValue
F32 = Text
"validation.validate_float"
validatorForBasicType BasicTypeValue
F64 = Text
"validation.validate_float"
validatorForBasicType BasicTypeValue
Boolean = Text
"validation.validate_bool"

validatorForLiteralType :: LiteralTypeValue -> Text
validatorForLiteralType :: LiteralTypeValue -> Text
validatorForLiteralType (LiteralString Text
s) = Text
"validation.validate_literal(\'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\')"
validatorForLiteralType (LiteralInteger Integer
i) = Text
"validation.validate_literal(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
validatorForLiteralType (LiteralFloat Float
f) = Text
"validation.validate_literal(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Float -> Text
forall a. Show a => a -> Text
tshow Float
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
validatorForLiteralType (LiteralBoolean Bool
b) = Text
"validation.validate_literal(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall a. Show a => a -> Text
tshow Bool
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

validatorForComplexType :: ComplexTypeValue -> Text
validatorForComplexType :: ComplexTypeValue -> Text
validatorForComplexType (PointerType FieldType
fieldType) = FieldType -> Text
validatorForFieldType FieldType
fieldType
validatorForComplexType (ArrayType Integer
_size FieldType
fieldType) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"validation.validate_list(", FieldType -> Text
validatorForFieldType FieldType
fieldType, Text
")"]
validatorForComplexType (SliceType FieldType
fieldType) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"validation.validate_list(", FieldType -> Text
validatorForFieldType FieldType
fieldType, Text
")"]
validatorForComplexType (OptionalType FieldType
fieldType) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"validation.validate_optional(", FieldType -> Text
validatorForFieldType FieldType
fieldType, Text
")"]

decoderForDefinitionReference :: DefinitionReference -> Text
decoderForDefinitionReference :: DefinitionReference -> Text
decoderForDefinitionReference
  ( DefinitionReference
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".validate"
decoderForDefinitionReference
  ( ImportedDefinitionReference
      (ModuleName Text
moduleName)
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
".validate"]
decoderForDefinitionReference
  ( AppliedGenericReference
      [FieldType]
appliedTypes
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    let appliedDecoders :: Text
appliedDecoders = [FieldType]
appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Text
validatorForFieldType [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
" "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, Text
".validate(", Text
appliedDecoders, Text
")"]
decoderForDefinitionReference
  ( AppliedImportedGenericReference
      (ModuleName Text
moduleName)
      (AppliedTypes [FieldType]
appliedTypes)
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    let appliedDecoders :: Text
appliedDecoders = [FieldType]
appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Text
validatorForFieldType [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
" "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
".validate(", Text
appliedDecoders, Text
")"]
decoderForDefinitionReference
  ( GenericDeclarationReference
      (ModuleName Text
moduleName)
      (DefinitionName Text
name)
      (AppliedTypes [FieldType]
appliedTypes)
    ) =
    let appliedDecoders :: Text
appliedDecoders = [FieldType]
appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Text
validatorForFieldType [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
" "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
".validate(", Text
appliedDecoders, Text
")"]
decoderForDefinitionReference
  (DeclarationReference (ModuleName Text
moduleName) (DefinitionName Text
name)) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
".validate"]

outputUnion :: Text -> FieldName -> UnionType -> Text
outputUnion :: Text -> FieldName -> UnionType -> Text
outputUnion Text
name FieldName
typeTag UnionType
unionType =
  let baseClassOutput :: Text
baseClassOutput = Text -> FieldName -> [Constructor] -> [TypeVariable] -> Text
outputUnionBaseClass Text
name FieldName
typeTag (UnionType -> [Constructor]
constructorsFrom UnionType
unionType) [TypeVariable]
typeVariables
      casesOutput :: Text
casesOutput = Text -> [TypeVariable] -> FieldName -> [Constructor] -> Text
outputUnionCases Text
fullUnionName [TypeVariable]
typeVariables FieldName
typeTag (UnionType -> [Constructor]
constructorsFrom UnionType
unionType)
      fullUnionName :: Text
fullUnionName =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
name
          else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables]
      constructorsFrom :: UnionType -> [Constructor]
constructorsFrom (PlainUnion [Constructor]
constructors) = [Constructor]
constructors
      constructorsFrom (GenericUnion [TypeVariable]
_typeVariables [Constructor]
constructors) = [Constructor]
constructors
      typeVariables :: [TypeVariable]
typeVariables = case UnionType
unionType of
        PlainUnion [Constructor]
_constructors -> []
        GenericUnion [TypeVariable]
ts [Constructor]
_constructors -> [TypeVariable]
ts
      maybeTypeVariableOutput :: Text
maybeTypeVariableOutput =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
""
          else
            [TypeVariable]
typeVariables
              [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
t, Text
" = typing.TypeVar('", Text
t, Text
"')"])
              [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n"
              Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
maybeTypeVariableOutput, Text
baseClassOutput, Text
"\n\n", Text
casesOutput]

outputUnionBaseClass :: Text -> FieldName -> [Constructor] -> [TypeVariable] -> Text
outputUnionBaseClass :: Text -> FieldName -> [Constructor] -> [TypeVariable] -> Text
outputUnionBaseClass Text
name FieldName
tag [Constructor]
constructors [TypeVariable]
typeVariables =
  let validatorOutput :: Text
validatorOutput = Text -> FieldName -> [Constructor] -> [TypeVariable] -> Text
outputUnionValidator Text
name FieldName
tag [Constructor]
constructors [TypeVariable]
typeVariables
      decoderOutput :: Text
decoderOutput = Text -> [TypeVariable] -> Text
outputUnionDecoder Text
name [TypeVariable]
typeVariables
      maybeGenericNotation :: Text
maybeGenericNotation =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
""
          else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"(typing.Generic", [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables, Text
")"]
      maybeTypeVariableToJSONArguments :: Text
maybeTypeVariableToJSONArguments =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
""
          else
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
", ",
                [TypeVariable]
typeVariables
                  [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
t, Text
"_to_json: encoding.ToJSON[", Text
t, Text
"]"])
                  [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
","
              ]
      stubsOutput :: Text
stubsOutput =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"    def to_json(self",
            Text
maybeTypeVariableToJSONArguments,
            Text
") -> typing.Dict[str, typing.Any]:\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"        raise NotImplementedError('`to_json` is not implemented for base class `",
                Text
name,
                Text
"`')\n\n"
              ],
            Text
"    def encode(self) -> str:\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"        raise NotImplementedError('`encode` is not implemented for base class `",
                Text
name,
                Text
"`')"
              ]
          ]
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"class ", Text
name, Text
maybeGenericNotation, Text
":\n"],
          Text
validatorOutput,
          Text
"\n\n",
          Text
decoderOutput,
          Text
"\n\n",
          Text
stubsOutput
        ]

outputUnionValidator :: Text -> FieldName -> [Constructor] -> [TypeVariable] -> Text
outputUnionValidator :: Text -> FieldName -> [Constructor] -> [TypeVariable] -> Text
outputUnionValidator Text
name (FieldName Text
tag) [Constructor]
constructors [TypeVariable]
typeVariables =
  let taggedValidators :: Text
taggedValidators =
        [Constructor]
constructors
          [Constructor] -> ([Constructor] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Constructor -> Text) -> [Constructor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \(Constructor (ConstructorName Text
constructorName) Maybe FieldType
maybePayload) ->
                let payloadTypeVariables :: [TypeVariable]
payloadTypeVariables =
                      [TypeVariable] -> Maybe [TypeVariable] -> [TypeVariable]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [TypeVariable] -> [TypeVariable])
-> Maybe [TypeVariable] -> [TypeVariable]
forall a b. (a -> b) -> a -> b
$ (FieldType -> Maybe [TypeVariable])
-> Maybe FieldType -> Maybe [TypeVariable]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FieldType -> Maybe [TypeVariable]
typeVariablesFrom Maybe FieldType
maybePayload
                    maybeTypeVariableValidatorArguments :: Text
maybeTypeVariableValidatorArguments =
                      if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
payloadTypeVariables
                        then Text
""
                        else
                          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                            [ Text
"(",
                              [TypeVariable]
payloadTypeVariables
                                [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> Text
"validate_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
                                [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate
                                  Text
", ",
                              Text
")"
                            ]
                 in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                      [ Text
"'",
                        Text
constructorName,
                        Text
"': ",
                        Text -> Text
upperCaseFirstCharacter Text
constructorName,
                        Text
".validate",
                        Text
maybeTypeVariableValidatorArguments
                      ]
            )
          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
      interface :: Text
interface = Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
taggedValidators Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
      functionHead :: [TypeVariable] -> Text
functionHead [] =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    def validate(value: validation.Unknown) -> validation.ValidationResult['", Text
name, Text
"']:\n"]
      functionHead [TypeVariable]
typeVariables' =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"    def validate(",
            [TypeVariable] -> Text
typeVariableValidatorsAsArguments [TypeVariable]
typeVariables',
            Text
") -> validation.Validator['",
            Text
fullName,
            Text
"']:\n"
          ]
      functionBody :: [TypeVariable] -> Text
functionBody [] =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return validation.validate_with_type_tags(value, '", Text
tag, Text
"', ", Text
interface, Text
")"]
      functionBody [TypeVariable]
typeVariables' =
        let validatorName :: Text
validatorName =
              Text
"validate_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([TypeVariable]
typeVariables' [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> Text
t) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat)
         in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ Text
"        def ",
                    Text
validatorName,
                    Text
"(value: validation.Unknown) -> validation.ValidationResult['",
                    Text
fullName,
                    Text
"']:\n"
                  ],
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ Text
"            return validation.validate_with_type_tags(value, '",
                    Text
tag,
                    Text
"', ",
                    Text
interface,
                    Text
")\n"
                  ],
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return ", Text
validatorName]
              ]
      fullName :: Text
fullName =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
name
          else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables]
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"    @staticmethod\n",
          [TypeVariable] -> Text
functionHead [TypeVariable]
typeVariables,
          [TypeVariable] -> Text
functionBody [TypeVariable]
typeVariables
        ]

outputUnionDecoder :: Text -> [TypeVariable] -> Text
outputUnionDecoder :: Text -> [TypeVariable] -> Text
outputUnionDecoder Text
unionName [TypeVariable]
typeVariables =
  let maybeTypeVariableValidatorArguments :: Text
maybeTypeVariableValidatorArguments =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
""
          else
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
", ",
                [TypeVariable]
typeVariables
                  [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                    ( \(TypeVariable Text
t) ->
                        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                          [ Text
"validate_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t,
                            Text
": validation.Validator[",
                            Text
t,
                            Text
"]"
                          ]
                    )
                  [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate
                    Text
", "
              ]
      maybePassedInValidators :: Text
maybePassedInValidators =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
""
          else
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"(",
                [TypeVariable]
typeVariables
                  [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> Text
"validate_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
                  [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", ",
                Text
")"
              ]
      fullName :: Text
fullName =
        if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then Text
unionName
          else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
unionName, [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables]
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"    @staticmethod\n",
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"    def decode(string: typing.Union[str, bytes]",
              Text
maybeTypeVariableValidatorArguments,
              Text
") -> validation.ValidationResult['",
              Text
fullName,
              Text
"']:\n"
            ],
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"        return validation.validate_from_string(string, ",
              Text
unionName,
              Text
".validate",
              Text
maybePassedInValidators,
              Text
")"
            ]
        ]

outputUnionCases :: Text -> [TypeVariable] -> FieldName -> [Constructor] -> Text
outputUnionCases :: Text -> [TypeVariable] -> FieldName -> [Constructor] -> Text
outputUnionCases Text
unionName [TypeVariable]
unionTypeVariables FieldName
tag =
  (Constructor -> Text) -> [Constructor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> [TypeVariable] -> FieldName -> Constructor -> Text
outputUnionCase Text
unionName [TypeVariable]
unionTypeVariables FieldName
tag) ([Constructor] -> [Text])
-> ([Text] -> Text) -> [Constructor] -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> [Text] -> Text
Text.intercalate Text
"\n\n"

outputUnionCase :: Text -> [TypeVariable] -> FieldName -> Constructor -> Text
outputUnionCase :: Text -> [TypeVariable] -> FieldName -> Constructor -> Text
outputUnionCase
  Text
unionName
  [TypeVariable]
unionTypeVariables
  fieldName :: FieldName
fieldName@(FieldName Text
tag)
  constructor :: Constructor
constructor@(Constructor (ConstructorName Text
name) Maybe FieldType
maybePayload) =
    let payloadTypeVariables :: [TypeVariable]
payloadTypeVariables =
          [TypeVariable] -> Maybe [TypeVariable] -> [TypeVariable]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [TypeVariable] -> [TypeVariable])
-> Maybe [TypeVariable] -> [TypeVariable]
forall a b. (a -> b) -> a -> b
$ (FieldType -> Maybe [TypeVariable])
-> Maybe FieldType -> Maybe [TypeVariable]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FieldType -> Maybe [TypeVariable]
typeVariablesFrom Maybe FieldType
maybePayload
        fullName :: Text
fullName =
          if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
payloadTypeVariables
            then Text
name
            else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
payloadTypeVariables]
        maybeDataField :: Text
maybeDataField =
          Maybe FieldType
maybePayload Maybe FieldType -> (Maybe FieldType -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> (FieldType -> Text) -> Maybe FieldType -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (FieldType -> Text
outputFieldType (FieldType -> Text) -> (Text -> Text) -> FieldType -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text
"    data: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"))
        interface :: Text
interface =
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"{", Maybe FieldType
maybePayload Maybe FieldType -> (Maybe FieldType -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> (FieldType -> Text) -> Maybe FieldType -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (FieldType -> Text
validatorForFieldType (FieldType -> Text) -> (Text -> Text) -> FieldType -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text
"'data': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)), Text
"}"]
        validatorOutput :: Text
validatorOutput =
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"    @staticmethod\n",
              [TypeVariable] -> Text
validatorFunctionHead [TypeVariable]
payloadTypeVariables,
              [TypeVariable] -> Text
validatorFunctionBody [TypeVariable]
payloadTypeVariables
            ]
        validatorFunctionHead :: [TypeVariable] -> Text
validatorFunctionHead [] =
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    def validate(value: validation.Unknown) -> validation.ValidationResult['", Text
name, Text
"']:\n"]
        validatorFunctionHead [TypeVariable]
typeVariables =
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"    def validate(",
              [TypeVariable] -> Text
typeVariableValidatorsAsArguments [TypeVariable]
typeVariables,
              Text
") -> validation.Validator['",
              Text
fullName,
              Text
"']:\n"
            ]
        validatorFunctionBody :: [TypeVariable] -> Text
validatorFunctionBody [] =
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"        return validation.validate_with_type_tag(value, '",
              Text
tag,
              Text
"', '",
              Text
name,
              Text
"', ",
              Text
interface,
              Text
", ",
              Text
name,
              Text
")"
            ]
        validatorFunctionBody [TypeVariable]
typeVariables =
          let validatorName :: Text
validatorName =
                Text
"validate_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([TypeVariable]
typeVariables [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> Text
t) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat)
           in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"        def ",
                      Text
validatorName,
                      Text
"(value: validation.Unknown) -> validation.ValidationResult['",
                      Text
fullName,
                      Text
"']:\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"            return validation.validate_with_type_tag(value, '",
                      Text
tag,
                      Text
"', '",
                      Text
name,
                      Text
"', ",
                      Text
interface,
                      Text
", ",
                      Text
name,
                      Text
")\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return ", Text
validatorName]
                ]
        decoderOutput :: Text
decoderOutput =
          let maybeTypeVariableValidatorArguments :: Text
maybeTypeVariableValidatorArguments =
                if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
payloadTypeVariables
                  then Text
""
                  else
                    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                      [ Text
", ",
                        [TypeVariable]
payloadTypeVariables
                          [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"validate_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t, Text
": validation.Validator[", Text
t, Text
"]"])
                          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
                      ]
              maybePassedInValidators :: Text
maybePassedInValidators =
                if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
payloadTypeVariables
                  then Text
""
                  else
                    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                      [ Text
"(",
                        [TypeVariable]
payloadTypeVariables
                          [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> Text
"validate_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
                          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", ",
                        Text
")"
                      ]
           in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"    @staticmethod\n",
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"    def decode(string: typing.Union[str, bytes]",
                      Text
maybeTypeVariableValidatorArguments,
                      Text
") -> validation.ValidationResult['",
                      Text
fullName,
                      Text
"']:\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"        return validation.validate_from_string(string, ",
                      Text
name,
                      Text
".validate",
                      Text
maybePassedInValidators,
                      Text
")"
                    ]
                ]
        encoderOutput :: Text
encoderOutput = [TypeVariable] -> FieldName -> Constructor -> Text
outputEncoderForUnionConstructor [TypeVariable]
unionTypeVariables FieldName
fieldName Constructor
constructor
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"@dataclass(frozen=True)\n",
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"class ", Text
name, Text
"(", Text
unionName, Text
"):\n"],
            Text
maybeDataField,
            Text
validatorOutput,
            Text
"\n\n",
            Text
decoderOutput,
            Text
"\n\n",
            Text
encoderOutput
          ]

outputEncoderForUnionConstructor :: [TypeVariable] -> FieldName -> Constructor -> Text
outputEncoderForUnionConstructor :: [TypeVariable] -> FieldName -> Constructor -> Text
outputEncoderForUnionConstructor
  [TypeVariable]
unionTypeVariables
  (FieldName Text
tag)
  (Constructor (ConstructorName Text
name) Maybe FieldType
maybePayload) =
    let maybeDataField :: Text
maybeDataField =
          Text -> (FieldType -> Text) -> Maybe FieldType -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (FieldType -> Text
dataEncoder (FieldType -> Text) -> (Text -> Text) -> FieldType -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text
", 'data': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) Maybe FieldType
maybePayload
        dataEncoder :: FieldType -> Text
dataEncoder (BasicType BasicTypeValue
_) = Text
"self.data"
        dataEncoder (DefinitionReferenceType DefinitionReference
_) =
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"self.data.to_json(", Text
maybePassedInToJSONs, Text
")"]
        dataEncoder FieldType
fieldType = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [(Text, Text) -> FieldType -> Text
encoderForFieldType (Text
"", Text
"") FieldType
fieldType, Text
"(self.data)"]
        maybeTypeVariableToJSONArguments :: Text
maybeTypeVariableToJSONArguments =
          if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
unionTypeVariables
            then Text
""
            else
              [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
", ",
                  [TypeVariable]
unionTypeVariables
                    [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                      ( \(TypeVariable Text
t) ->
                          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
t, Text
"_to_json: encoding.ToJSON[", Text
t, Text
"]"]
                      )
                    [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
                ]
        interface :: Text
interface = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"{", [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"'", Text
tag, Text
"': '", Text
name, Text
"'", Text
maybeDataField], Text
"}"]
        maybePassedInToJSONs :: Text
maybePassedInToJSONs =
          if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
unionTypeVariables
            then Text
""
            else
              [TypeVariable]
unionTypeVariables
                [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_to_json")
                [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    def to_json(self", Text
maybeTypeVariableToJSONArguments, Text
") -> typing.Dict[str, typing.Any]:\n"],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return ", Text
interface, Text
"\n\n"],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    def encode(self", Text
maybeTypeVariableToJSONArguments, Text
") -> str:\n"],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"        return json.dumps(self.to_json(", Text
maybePassedInToJSONs, Text
"))"]
          ]

typeVariableValidatorsAsArguments :: [TypeVariable] -> Text
typeVariableValidatorsAsArguments :: [TypeVariable] -> Text
typeVariableValidatorsAsArguments [] = Text
""
typeVariableValidatorsAsArguments [TypeVariable]
typeVariables =
  let types :: [Text]
types = (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"validation.Validator[", Text
t, Text
"]"]) [TypeVariable]
typeVariables
   in [TypeVariable]
typeVariables
        [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& [TypeVariable] -> [Text]
validatorsForTypeVariables
        [Text] -> ([Text] -> [(Text, Text)]) -> [(Text, Text)]
forall a b. a -> (a -> b) -> b
& [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
types
        [(Text, Text)] -> ([(Text, Text)] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
t, Text
v) -> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "

validatorsForTypeVariables :: [TypeVariable] -> [Text]
validatorsForTypeVariables :: [TypeVariable] -> [Text]
validatorsForTypeVariables = (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeVariable -> FieldType
TypeVariableReferenceType (TypeVariable -> FieldType)
-> (FieldType -> Text) -> TypeVariable -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FieldType -> Text
validatorForFieldType)

typeVariablesFrom :: FieldType -> Maybe [TypeVariable]
typeVariablesFrom :: FieldType -> Maybe [TypeVariable]
typeVariablesFrom (TypeVariableReferenceType TypeVariable
typeVariable) = [TypeVariable] -> Maybe [TypeVariable]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeVariable
typeVariable]
typeVariablesFrom (ComplexType (ArrayType Integer
_size FieldType
fieldType)) = FieldType -> Maybe [TypeVariable]
typeVariablesFrom FieldType
fieldType
typeVariablesFrom (ComplexType (SliceType FieldType
fieldType)) = FieldType -> Maybe [TypeVariable]
typeVariablesFrom FieldType
fieldType
typeVariablesFrom (ComplexType (PointerType FieldType
fieldType)) = FieldType -> Maybe [TypeVariable]
typeVariablesFrom FieldType
fieldType
typeVariablesFrom (ComplexType (OptionalType FieldType
fieldType)) = FieldType -> Maybe [TypeVariable]
typeVariablesFrom FieldType
fieldType
typeVariablesFrom (RecursiveReferenceType DefinitionName
_name) = Maybe [TypeVariable]
forall a. Maybe a
Nothing
typeVariablesFrom (LiteralType LiteralTypeValue
_) = Maybe [TypeVariable]
forall a. Maybe a
Nothing
typeVariablesFrom (BasicType BasicTypeValue
_) = Maybe [TypeVariable]
forall a. Maybe a
Nothing
typeVariablesFrom (DefinitionReferenceType DefinitionReference
definitionReference) =
  DefinitionReference -> Maybe [TypeVariable]
typeVariablesFromReference DefinitionReference
definitionReference

typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable]
typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable]
typeVariablesFromReference (DefinitionReference TypeDefinition
definition) = TypeDefinition -> Maybe [TypeVariable]
typeVariablesFromDefinition TypeDefinition
definition
typeVariablesFromReference (ImportedDefinitionReference ModuleName
_moduleName TypeDefinition
definition) =
  TypeDefinition -> Maybe [TypeVariable]
typeVariablesFromDefinition TypeDefinition
definition
typeVariablesFromReference (AppliedGenericReference [FieldType]
fieldTypes TypeDefinition
_definition) =
  let typeVariables :: [TypeVariable]
typeVariables = [FieldType]
fieldTypes [FieldType]
-> ([FieldType] -> [Maybe [TypeVariable]])
-> [Maybe [TypeVariable]]
forall a b. a -> (a -> b) -> b
& (FieldType -> Maybe [TypeVariable])
-> [FieldType] -> [Maybe [TypeVariable]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Maybe [TypeVariable]
typeVariablesFrom [Maybe [TypeVariable]]
-> ([Maybe [TypeVariable]] -> [[TypeVariable]]) -> [[TypeVariable]]
forall a b. a -> (a -> b) -> b
& [Maybe [TypeVariable]] -> [[TypeVariable]]
forall a. [Maybe a] -> [a]
catMaybes [[TypeVariable]]
-> ([[TypeVariable]] -> [TypeVariable]) -> [TypeVariable]
forall a b. a -> (a -> b) -> b
& [[TypeVariable]] -> [TypeVariable]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
   in if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables then Maybe [TypeVariable]
forall a. Maybe a
Nothing else [TypeVariable] -> Maybe [TypeVariable]
forall a. a -> Maybe a
Just [TypeVariable]
typeVariables
typeVariablesFromReference
  ( AppliedImportedGenericReference
      ModuleName
_moduleName
      (AppliedTypes [FieldType]
fieldTypes)
      TypeDefinition
_definition
    ) =
    let typeVariables :: [TypeVariable]
typeVariables = [FieldType]
fieldTypes [FieldType]
-> ([FieldType] -> [Maybe [TypeVariable]])
-> [Maybe [TypeVariable]]
forall a b. a -> (a -> b) -> b
& (FieldType -> Maybe [TypeVariable])
-> [FieldType] -> [Maybe [TypeVariable]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Maybe [TypeVariable]
typeVariablesFrom [Maybe [TypeVariable]]
-> ([Maybe [TypeVariable]] -> [[TypeVariable]]) -> [[TypeVariable]]
forall a b. a -> (a -> b) -> b
& [Maybe [TypeVariable]] -> [[TypeVariable]]
forall a. [Maybe a] -> [a]
catMaybes [[TypeVariable]]
-> ([[TypeVariable]] -> [TypeVariable]) -> [TypeVariable]
forall a b. a -> (a -> b) -> b
& [[TypeVariable]] -> [TypeVariable]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
     in if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables then Maybe [TypeVariable]
forall a. Maybe a
Nothing else [TypeVariable] -> Maybe [TypeVariable]
forall a. a -> Maybe a
Just [TypeVariable]
typeVariables
typeVariablesFromReference
  ( GenericDeclarationReference
      ModuleName
_moduleName
      DefinitionName
_definitionName
      (AppliedTypes [FieldType]
fieldTypes)
    ) =
    let typeVariables :: [TypeVariable]
typeVariables = [FieldType]
fieldTypes [FieldType]
-> ([FieldType] -> [Maybe [TypeVariable]])
-> [Maybe [TypeVariable]]
forall a b. a -> (a -> b) -> b
& (FieldType -> Maybe [TypeVariable])
-> [FieldType] -> [Maybe [TypeVariable]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Maybe [TypeVariable]
typeVariablesFrom [Maybe [TypeVariable]]
-> ([Maybe [TypeVariable]] -> [[TypeVariable]]) -> [[TypeVariable]]
forall a b. a -> (a -> b) -> b
& [Maybe [TypeVariable]] -> [[TypeVariable]]
forall a. [Maybe a] -> [a]
catMaybes [[TypeVariable]]
-> ([[TypeVariable]] -> [TypeVariable]) -> [TypeVariable]
forall a b. a -> (a -> b) -> b
& [[TypeVariable]] -> [TypeVariable]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
     in if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables then Maybe [TypeVariable]
forall a. Maybe a
Nothing else [TypeVariable] -> Maybe [TypeVariable]
forall a. a -> Maybe a
Just [TypeVariable]
typeVariables
typeVariablesFromReference (DeclarationReference ModuleName
_moduleName DefinitionName
_definitionName) =
  Maybe [TypeVariable]
forall a. Maybe a
Nothing

typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable]
typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable]
typeVariablesFromDefinition (TypeDefinition DefinitionName
_name (Struct (PlainStruct [StructField]
_))) = Maybe [TypeVariable]
forall a. Maybe a
Nothing
typeVariablesFromDefinition (TypeDefinition DefinitionName
_name (Union FieldName
_tagType (PlainUnion [Constructor]
_))) = Maybe [TypeVariable]
forall a. Maybe a
Nothing
typeVariablesFromDefinition (TypeDefinition DefinitionName
_name (UntaggedUnion [FieldType]
_)) = Maybe [TypeVariable]
forall a. Maybe a
Nothing
typeVariablesFromDefinition (TypeDefinition DefinitionName
_name (Enumeration [EnumerationValue]
_)) = Maybe [TypeVariable]
forall a. Maybe a
Nothing
typeVariablesFromDefinition (TypeDefinition DefinitionName
_name (EmbeddedUnion FieldName
_tagType [EmbeddedConstructor]
_constructors)) = Maybe [TypeVariable]
forall a. Maybe a
Nothing
typeVariablesFromDefinition (TypeDefinition DefinitionName
_name (Struct (GenericStruct [TypeVariable]
typeVariables [StructField]
_))) =
  [TypeVariable] -> Maybe [TypeVariable]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeVariable]
typeVariables
typeVariablesFromDefinition (TypeDefinition DefinitionName
_name (Union FieldName
_tagType (GenericUnion [TypeVariable]
typeVariables [Constructor]
_))) =
  [TypeVariable] -> Maybe [TypeVariable]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeVariable]
typeVariables
typeVariablesFromDefinition (TypeDefinition DefinitionName
_name (DeclaredType ModuleName
_moduleName [TypeVariable]
typeVariables)) =
  [TypeVariable] -> Maybe [TypeVariable]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeVariable]
typeVariables

outputField :: Int -> StructField -> Text
outputField :: Int -> StructField -> Text
outputField Int
indentation (StructField (FieldName Text
name) FieldType
fieldType) =
  let indent :: Text
indent = [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
indentation Char
' '
   in Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, Text
": ", FieldType -> Text
outputFieldType FieldType
fieldType]

outputFieldType :: FieldType -> Text
outputFieldType :: FieldType -> Text
outputFieldType (LiteralType (LiteralString Text
text)) = Text
"typing.Literal['" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"']"
outputFieldType (LiteralType (LiteralInteger Integer
x)) = Text
"typing.Literal['" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"']"
outputFieldType (LiteralType (LiteralFloat Float
f)) = Text
"typing.Literal['" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Float -> Text
forall a. Show a => a -> Text
tshow Float
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"']"
outputFieldType (LiteralType (LiteralBoolean Bool
b)) = Text
"typing.Literal['" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall a. Show a => a -> Text
tshow Bool
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"']"
outputFieldType (BasicType BasicTypeValue
basicType) = BasicTypeValue -> Text
outputBasicType BasicTypeValue
basicType
outputFieldType (ComplexType (OptionalType FieldType
fieldType)) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"typing.Optional[", FieldType -> Text
outputFieldType FieldType
fieldType, Text
"]"]
outputFieldType (ComplexType (ArrayType Integer
_size FieldType
fieldType)) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"typing.List[", FieldType -> Text
outputFieldType FieldType
fieldType, Text
"]"]
outputFieldType (ComplexType (SliceType FieldType
fieldType)) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"typing.List[", FieldType -> Text
outputFieldType FieldType
fieldType, Text
"]"]
outputFieldType (ComplexType (PointerType FieldType
fieldType)) = FieldType -> Text
outputFieldType FieldType
fieldType
outputFieldType (RecursiveReferenceType (DefinitionName Text
name)) = Text
name
outputFieldType (DefinitionReferenceType DefinitionReference
definitionReference) =
  DefinitionReference -> Text
outputDefinitionReference DefinitionReference
definitionReference
outputFieldType (TypeVariableReferenceType (TypeVariable Text
t)) = Text
t

outputDefinitionReference :: DefinitionReference -> Text
outputDefinitionReference :: DefinitionReference -> Text
outputDefinitionReference (DefinitionReference (TypeDefinition (DefinitionName Text
name) TypeData
_)) = Text
name
outputDefinitionReference
  ( ImportedDefinitionReference
      (ModuleName Text
moduleName)
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name]
outputDefinitionReference
  ( AppliedGenericReference
      [FieldType]
appliedTypes
      (TypeDefinition (DefinitionName Text
name) TypeData
_)
    ) =
    let appliedFieldTypes :: Text
appliedFieldTypes = [FieldType]
appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Text
outputFieldType [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
name, Text
"[", Text
appliedFieldTypes, Text
"]"]
outputDefinitionReference
  ( AppliedImportedGenericReference
      (ModuleName Text
moduleName)
      (AppliedTypes [FieldType]
appliedTypes)
      (TypeDefinition (DefinitionName Text
name) TypeData
_)
    ) =
    let appliedFieldTypes :: Text
appliedFieldTypes = [FieldType]
appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Text
outputFieldType [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
"[", Text
appliedFieldTypes, Text
"]"]
outputDefinitionReference
  ( GenericDeclarationReference
      (ModuleName Text
moduleName)
      (DefinitionName Text
name)
      (AppliedTypes [FieldType]
appliedTypes)
    ) =
    let appliedFieldTypes :: Text
appliedFieldTypes = [FieldType]
appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (FieldType -> Text) -> [FieldType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Text
outputFieldType [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
        maybeAppliedOutput :: Text
maybeAppliedOutput = if [FieldType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldType]
appliedTypes then Text
"" else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"[", Text
appliedFieldTypes, Text
"]"]
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name, Text
maybeAppliedOutput]
outputDefinitionReference (DeclarationReference (ModuleName Text
moduleName) (DefinitionName Text
name)) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".", Text
name]

outputBasicType :: BasicTypeValue -> Text
outputBasicType :: BasicTypeValue -> Text
outputBasicType BasicTypeValue
BasicString = Text
"str"
outputBasicType BasicTypeValue
U8 = Text
"int"
outputBasicType BasicTypeValue
U16 = Text
"int"
outputBasicType BasicTypeValue
U32 = Text
"int"
outputBasicType BasicTypeValue
U64 = Text
"int"
outputBasicType BasicTypeValue
U128 = Text
"int"
outputBasicType BasicTypeValue
I8 = Text
"int"
outputBasicType BasicTypeValue
I16 = Text
"int"
outputBasicType BasicTypeValue
I32 = Text
"int"
outputBasicType BasicTypeValue
I64 = Text
"int"
outputBasicType BasicTypeValue
I128 = Text
"int"
outputBasicType BasicTypeValue
F32 = Text
"float"
outputBasicType BasicTypeValue
F64 = Text
"float"
outputBasicType BasicTypeValue
Boolean = Text
"bool"

fieldTypeName :: FieldType -> Text
fieldTypeName :: FieldType -> Text
fieldTypeName (LiteralType LiteralTypeValue
_) = [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"Just don't use literals in untagged unions"
fieldTypeName (RecursiveReferenceType DefinitionName
_) =
  [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"Just don't use recursive references in untagged unions"
fieldTypeName (BasicType BasicTypeValue
BasicString) = Text
"str"
fieldTypeName (BasicType BasicTypeValue
F32) = Text
"float"
fieldTypeName (BasicType BasicTypeValue
F64) = Text
"float"
fieldTypeName (BasicType BasicTypeValue
U8) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
U16) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
U32) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
U64) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
U128) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
I8) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
I16) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
I32) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
I64) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
I128) = Text
"int"
fieldTypeName (BasicType BasicTypeValue
Boolean) = Text
"bool"
fieldTypeName (TypeVariableReferenceType (TypeVariable Text
t)) = Text
t
fieldTypeName (ComplexType (ArrayType Integer
_ FieldType
_arrayFieldType)) = Text
"list"
fieldTypeName (ComplexType (SliceType FieldType
_sliceFieldType)) = Text
"list"
fieldTypeName (ComplexType (PointerType FieldType
pointerFieldType)) = FieldType -> Text
fieldTypeName FieldType
pointerFieldType
fieldTypeName (ComplexType (OptionalType FieldType
optionalFieldType)) = FieldType -> Text
fieldTypeName FieldType
optionalFieldType
fieldTypeName
  ( DefinitionReferenceType
      (DefinitionReference (TypeDefinition (DefinitionName Text
definitionName) TypeData
_))
    ) =
    Text
definitionName
fieldTypeName
  ( DefinitionReferenceType
      (ImportedDefinitionReference ModuleName
_ (TypeDefinition (DefinitionName Text
definitionName) TypeData
_))
    ) =
    Text
definitionName
fieldTypeName
  ( DefinitionReferenceType
      ( AppliedGenericReference
          [FieldType]
_fieldTypes
          (TypeDefinition (DefinitionName Text
definitionName) TypeData
_)
        )
    ) =
    Text
definitionName
fieldTypeName
  ( DefinitionReferenceType
      ( AppliedImportedGenericReference
          ModuleName
_moduleName
          (AppliedTypes [FieldType]
_fieldTypes)
          (TypeDefinition (DefinitionName Text
definitionName) TypeData
_)
        )
    ) =
    Text
definitionName
fieldTypeName
  ( DefinitionReferenceType
      ( GenericDeclarationReference
          (ModuleName Text
_moduleName)
          (DefinitionName Text
definitionName)
          (AppliedTypes [FieldType]
_fieldTypes)
        )
    ) =
    Text
definitionName
fieldTypeName
  (DefinitionReferenceType (DeclarationReference ModuleName
_moduleName (DefinitionName Text
definitionName))) =
    Text
definitionName

joinTypeVariables :: [TypeVariable] -> Text
joinTypeVariables :: [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables =
  [TypeVariable]
typeVariables
    [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeVariable -> Text) -> [TypeVariable] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeVariable Text
t) -> Text
t)
    [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (\Text
o -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")

nameOfReference :: DefinitionReference -> DefinitionName
nameOfReference :: DefinitionReference -> DefinitionName
nameOfReference (DefinitionReference (TypeDefinition DefinitionName
name TypeData
_)) = DefinitionName
name
nameOfReference (ImportedDefinitionReference ModuleName
_moduleName (TypeDefinition DefinitionName
name TypeData
_)) = DefinitionName
name
nameOfReference (AppliedGenericReference [FieldType]
_fieldTypes (TypeDefinition DefinitionName
name TypeData
_)) = DefinitionName
name
nameOfReference (AppliedImportedGenericReference ModuleName
_moduleName AppliedTypes
_fieldTypes (TypeDefinition DefinitionName
name TypeData
_)) =
  DefinitionName
name
nameOfReference (GenericDeclarationReference ModuleName
_moduleName DefinitionName
name AppliedTypes
_fieldTypes) = DefinitionName
name
nameOfReference (DeclarationReference ModuleName
_moduleName DefinitionName
name) = DefinitionName
name