module CodeGeneration.TypeScript (outputModule) where

import CodeGeneration.Utilities (typeVariablesFrom, 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
forall a. Monoid a => [a] -> a
mconcat
      outputImport :: Import -> Text
outputImport (Import Module {$sel:name:Module :: Module -> ModuleName
name = ModuleName Text
name}) =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"import * as ", Text
name, Text
" from \"./", Text
name, Text
"\";\n\n"]
      declarationImportOutput :: Text
declarationImportOutput =
        [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
"import * as ", Text
name, Text
" from \"./", Text
name, Text
"\";"]
            )
          [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
modulePrelude,
          Text
"\n\n",
          Text
importsOutput,
          Text
declarationImportOutput,
          if [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
declarationNames then Text
"" else Text
"\n\n",
          Text
definitionOutput
        ]

modulePrelude :: Text
modulePrelude :: Text
modulePrelude = Text
"import * as svt from \"simple-validation-tools\";"

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 Text
_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
typeTag [EmbeddedConstructor]
constructors =
  let typeOutput :: Text
typeOutput =
        Text -> [Constructor] -> [TypeVariable] -> Text
outputCaseUnion
          Text
unionName
          [Constructor]
constructorsAsConstructors
          []
      constructorsAsConstructors :: [Constructor]
constructorsAsConstructors = [EmbeddedConstructor] -> [Constructor]
embeddedConstructorsToConstructors [EmbeddedConstructor]
constructors
      tagEnumerationOutput :: Text
tagEnumerationOutput = Text -> [Constructor] -> Text
outputUnionTagEnumeration Text
unionName [Constructor]
constructorsAsConstructors
      constructorTypesOutput :: Text
constructorTypesOutput = Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedConstructorTypes Text
unionName FieldName
typeTag [EmbeddedConstructor]
constructors
      caseConstructorsOutput :: Text
caseConstructorsOutput = Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedCaseConstructors Text
unionName FieldName
typeTag [EmbeddedConstructor]
constructors
      unionTypeGuardOutput :: Text
unionTypeGuardOutput = FieldName -> [TypeVariable] -> Text -> [Constructor] -> Text
outputUnionTypeGuard FieldName
typeTag [] Text
unionName [Constructor]
constructorsAsConstructors
      caseTypeGuardOutput :: Text
caseTypeGuardOutput = FieldName -> Text -> [EmbeddedConstructor] -> Text
outputEmbeddedCaseTypeGuards FieldName
typeTag Text
unionName [EmbeddedConstructor]
constructors
      unionValidatorOutput :: Text
unionValidatorOutput = [TypeVariable] -> FieldName -> Text -> [Constructor] -> Text
outputUnionValidator [] FieldName
typeTag Text
unionName [Constructor]
constructorsAsConstructors
      caseValidatorOutput :: Text
caseValidatorOutput = FieldName -> Text -> [EmbeddedConstructor] -> Text
outputEmbeddedCaseValidators FieldName
typeTag Text
unionName [EmbeddedConstructor]
constructors
   in Text -> [Text] -> Text
Text.intercalate
        Text
"\n\n"
        [ Text
typeOutput,
          Text
tagEnumerationOutput,
          Text
constructorTypesOutput,
          Text
caseConstructorsOutput,
          Text
unionTypeGuardOutput,
          Text
caseTypeGuardOutput,
          Text
unionValidatorOutput,
          Text
caseValidatorOutput
        ]

outputEmbeddedCaseTypeGuards :: FieldName -> Text -> [EmbeddedConstructor] -> Text
outputEmbeddedCaseTypeGuards :: FieldName -> Text -> [EmbeddedConstructor] -> Text
outputEmbeddedCaseTypeGuards FieldName
typeTag Text
unionName =
  (EmbeddedConstructor -> Text) -> [EmbeddedConstructor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldName -> Text -> EmbeddedConstructor -> Text
outputEmbeddedCaseTypeGuard FieldName
typeTag Text
unionName)
    ([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"

outputEmbeddedCaseTypeGuard :: FieldName -> Text -> EmbeddedConstructor -> Text
outputEmbeddedCaseTypeGuard :: FieldName -> Text -> EmbeddedConstructor -> Text
outputEmbeddedCaseTypeGuard
  (FieldName Text
tag)
  Text
unionName
  (EmbeddedConstructor (ConstructorName Text
name) Maybe DefinitionReference
Nothing) =
    let tagName :: Text
tagName = Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name
        interface :: Text
interface = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"{", Text
tag, Text
": ", Text
tagName, Text
"}"]
        constructorName :: Text
constructorName = Text -> Text
upperCaseFirstCharacter Text
name
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"export function is",
                Text
constructorName,
                Text
"(value: unknown): value is ",
                Text
constructorName,
                Text
" {\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return svt.isInterface<", Text
constructorName, Text
">(value, ", Text
interface, Text
");\n"],
            Text
"}"
          ]
outputEmbeddedCaseTypeGuard
  (FieldName Text
tag)
  Text
unionName
  (EmbeddedConstructor (ConstructorName Text
name) (Just DefinitionReference
reference)) =
    let fields :: [StructField]
fields = DefinitionReference -> [StructField]
structFieldsFromReference DefinitionReference
reference
        tagName :: Text
tagName = Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name
        interface :: Text
interface = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"{", Text
tag, Text
": ", Text
tagName, Text
", ", Text
fieldTypeGuards, Text
"}"]
        fieldTypeGuards :: Text
fieldTypeGuards = [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
outputStructTypeGuardForField [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
        constructorName :: Text
constructorName = Text -> Text
upperCaseFirstCharacter Text
name
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"export function is",
                Text
constructorName,
                Text
"(value: unknown): value is ",
                Text
constructorName,
                Text
" {\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return svt.isInterface<", Text
constructorName, Text
">(value, ", Text
interface, Text
");\n"],
            Text
"}"
          ]

outputEmbeddedCaseValidators :: FieldName -> Text -> [EmbeddedConstructor] -> Text
outputEmbeddedCaseValidators :: FieldName -> Text -> [EmbeddedConstructor] -> Text
outputEmbeddedCaseValidators FieldName
typeTag Text
unionName =
  (EmbeddedConstructor -> Text) -> [EmbeddedConstructor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldName -> Text -> EmbeddedConstructor -> Text
outputEmbeddedCaseValidator FieldName
typeTag Text
unionName)
    ([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"

outputEmbeddedCaseValidator :: FieldName -> Text -> EmbeddedConstructor -> Text
outputEmbeddedCaseValidator :: FieldName -> Text -> EmbeddedConstructor -> Text
outputEmbeddedCaseValidator
  (FieldName Text
tag)
  Text
unionName
  (EmbeddedConstructor (ConstructorName Text
name) Maybe DefinitionReference
Nothing) =
    let tagName :: Text
tagName = Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name
        interface :: Text
interface = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"{", Text
tag, Text
": ", Text
tagName, Text
"}"]
        constructorName :: Text
constructorName = Text -> Text
upperCaseFirstCharacter Text
name
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"export function validate",
                Text
constructorName,
                Text
"(value: unknown): svt.ValidationResult<",
                Text
constructorName,
                Text
"> {\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return svt.validate<", Text
constructorName, Text
">(value, ", Text
interface, Text
");\n"],
            Text
"}"
          ]
outputEmbeddedCaseValidator
  (FieldName Text
tag)
  Text
unionName
  (EmbeddedConstructor (ConstructorName Text
name) (Just DefinitionReference
reference)) =
    let fields :: [StructField]
fields = DefinitionReference -> [StructField]
structFieldsFromReference DefinitionReference
reference
        tagName :: Text
tagName = Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name
        interface :: Text
interface = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"{", Text
tag, Text
": ", Text
tagName, Text
", ", Text
fieldValidators, Text
"}"]
        fieldValidators :: Text
fieldValidators = [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
", "
        constructorName :: Text
constructorName = Text -> Text
upperCaseFirstCharacter Text
name
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"export function validate",
                Text
constructorName,
                Text
"(value: unknown): svt.ValidationResult<",
                Text
constructorName,
                Text
"> {\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return svt.validate<", Text
constructorName, Text
">(value, ", Text
interface, Text
");\n"],
            Text
"}"
          ]

outputEmbeddedConstructorTypes :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedConstructorTypes :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedConstructorTypes Text
unionName FieldName
fieldName [EmbeddedConstructor]
constructors =
  [EmbeddedConstructor]
constructors [EmbeddedConstructor]
-> ([EmbeddedConstructor] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (EmbeddedConstructor -> Text) -> [EmbeddedConstructor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorType Text
unionName FieldName
fieldName) [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n\n"

outputEmbeddedConstructorType :: Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorType :: Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedConstructorType
  Text
unionName
  (FieldName Text
tag)
  (EmbeddedConstructor (ConstructorName Text
name) Maybe DefinitionReference
Nothing) =
    let tagFieldOutput :: Text
tagFieldOutput = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    ", Text
tag, Text
": ", Text
tagValue, Text
";"]
        tagValue :: Text
tagValue = Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"export type ", Text -> Text
upperCaseFirstCharacter Text
name, Text
" = {\n"],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
tagFieldOutput, Text
"\n"],
            Text
"};"
          ]
outputEmbeddedConstructorType
  Text
unionName
  (FieldName Text
tag)
  (EmbeddedConstructor (ConstructorName Text
name) (Just DefinitionReference
fields)) =
    let fieldsOutput :: Text
fieldsOutput = DefinitionReference
fields DefinitionReference
-> (DefinitionReference -> [StructField]) -> [StructField]
forall a b. a -> (a -> b) -> b
& DefinitionReference -> [StructField]
structFieldsFromReference [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
outputField [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
""
        tagFieldOutput :: Text
tagFieldOutput = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    ", Text
tag, Text
": ", Text
tagValue, Text
";"]
        tagValue :: Text
tagValue = Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"export type ", Text -> Text
upperCaseFirstCharacter Text
name, Text
" = {\n"],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
tagFieldOutput, Text
"\n"],
            Text
fieldsOutput,
            Text
"};"
          ]

outputEmbeddedCaseConstructors :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedCaseConstructors :: Text -> FieldName -> [EmbeddedConstructor] -> Text
outputEmbeddedCaseConstructors Text
unionName FieldName
typeTag =
  (EmbeddedConstructor -> Text) -> [EmbeddedConstructor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedCaseConstructor Text
unionName FieldName
typeTag)
    ([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"

outputEmbeddedCaseConstructor :: Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedCaseConstructor :: Text -> FieldName -> EmbeddedConstructor -> Text
outputEmbeddedCaseConstructor
  Text
unionName
  (FieldName Text
tag)
  (EmbeddedConstructor (ConstructorName Text
name) Maybe DefinitionReference
Nothing) =
    let constructorName :: Text
constructorName = Text -> Text
upperCaseFirstCharacter Text
name
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"export function ",
                Text
constructorName,
                Text
"(): ",
                Text
constructorName,
                Text
" {\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"    return {",
                Text
tag,
                Text
": ",
                Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name,
                Text
"};\n"
              ],
            Text
"}"
          ]
outputEmbeddedCaseConstructor
  Text
unionName
  (FieldName Text
tag)
  (EmbeddedConstructor (ConstructorName Text
name) (Just DefinitionReference
definitionReference)) =
    let constructorName :: Text
constructorName = Text -> Text
upperCaseFirstCharacter Text
name
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"export function ",
                Text
constructorName,
                Text
"(data: ",
                DefinitionReference -> Text
outputDefinitionReference DefinitionReference
definitionReference,
                Text
"): ",
                Text
constructorName,
                Text
" {\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"    return {",
                Text
tag,
                Text
": ",
                Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name,
                Text
", ...data};\n"
              ],
            Text
"}"
          ]

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
"export type ", Text
unionName, Text
" = ", 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
outputFieldType [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
" | "
      typeGuardOutput :: Text
typeGuardOutput = Text -> [FieldType] -> Text
outputUntaggedUnionTypeGuard Text
unionName [FieldType]
cases
      validatorOutput :: Text
validatorOutput = Text -> [FieldType] -> Text
outputUntaggedUnionValidator Text
unionName [FieldType]
cases
   in Text -> [Text] -> Text
Text.intercalate Text
"\n\n" [Text
typeOutput, Text
typeGuardOutput, Text
validatorOutput]

outputUntaggedUnionTypeGuard :: Text -> [FieldType] -> Text
outputUntaggedUnionTypeGuard :: Text -> [FieldType] -> Text
outputUntaggedUnionTypeGuard Text
name [FieldType]
cases =
  let typeGuards :: Text
typeGuards = [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
outputTypeGuardForFieldType [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
"export function is", Text
name, Text
"(value: unknown): value is ", Text
name, Text
" {\n"],
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return [", Text
typeGuards, Text
"].some((typePredicate) => typePredicate(value));\n"],
          Text
"}"
        ]

outputUntaggedUnionValidator :: Text -> [FieldType] -> Text
outputUntaggedUnionValidator :: Text -> [FieldType] -> Text
outputUntaggedUnionValidator Text
name [FieldType]
cases =
  let validators :: Text
validators = [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
outputValidatorForFieldType [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
"export function validate",
              Text
name,
              Text
"(value: unknown): svt.ValidationResult<",
              Text
name,
              Text
"> {\n"
            ],
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return svt.validateOneOf<", Text
name, Text
">(value, [", Text
validators, Text
"]);\n"],
          Text
"}"
        ]

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
      typeGuardOutput :: Text
typeGuardOutput = Text -> [EnumerationValue] -> Text
outputEnumerationTypeGuard Text
name [EnumerationValue]
values
      validatorOutput :: Text
validatorOutput = Text -> [EnumerationValue] -> Text
outputEnumerationValidator Text
name [EnumerationValue]
values
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
typeOutput, Text
"\n\n", Text
typeGuardOutput, Text
"\n\n", Text
validatorOutput]

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
outputLiteral LiteralTypeValue
literal, Text
",\n"]
            )
          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      outputLiteral :: LiteralTypeValue -> Text
outputLiteral (LiteralString Text
s) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"\"", Text
s, Text
"\""]
      outputLiteral (LiteralInteger Integer
i) = Integer -> Text
forall a. Show a => a -> Text
tshow Integer
i
      outputLiteral (LiteralFloat Float
f) = Float -> Text
forall a. Show a => a -> Text
tshow Float
f
      outputLiteral (LiteralBoolean Bool
b) = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
b
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"export enum ", Text
name, Text
" {\n"],
          Text
valuesOutput,
          Text
"}"
        ]

outputEnumerationFunction ::
  FunctionPrefix ->
  ReturnType ->
  (Text -> [EnumerationValue] -> Text) ->
  Text ->
  [EnumerationValue] ->
  Text
outputEnumerationFunction :: FunctionPrefix
-> ReturnType
-> (Text -> [EnumerationValue] -> Text)
-> Text
-> [EnumerationValue]
-> Text
outputEnumerationFunction
  (FunctionPrefix Text
prefix)
  (ReturnType Text -> Text
returnType)
  Text -> [EnumerationValue] -> Text
returnExpression
  Text
name
  [EnumerationValue]
values =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"export function ", Text
prefix, Text
name, Text
"(value: unknown): ", Text -> Text
returnType Text
name, Text
" {\n"],
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return ", Text -> [EnumerationValue] -> Text
returnExpression Text
name [EnumerationValue]
values, Text
";\n"],
        Text
"}"
      ]

outputEnumerationTypeGuard :: Text -> [EnumerationValue] -> Text
outputEnumerationTypeGuard :: Text -> [EnumerationValue] -> Text
outputEnumerationTypeGuard =
  let returnExpression :: Text -> [EnumerationValue] -> Text
returnExpression 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
_value) -> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i)
                [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
valuesOutput, Text
"].some((v) => v === value)"]
      returnType :: a -> a
returnType a
name = a
"value is " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
name
   in FunctionPrefix
-> ReturnType
-> (Text -> [EnumerationValue] -> Text)
-> Text
-> [EnumerationValue]
-> Text
outputEnumerationFunction (Text -> FunctionPrefix
FunctionPrefix Text
"is") ((Text -> Text) -> ReturnType
ReturnType Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
returnType) Text -> [EnumerationValue] -> Text
returnExpression

outputEnumerationValidator :: Text -> [EnumerationValue] -> Text
outputEnumerationValidator :: Text -> [EnumerationValue] -> Text
outputEnumerationValidator =
  let returnExpression :: Text -> [EnumerationValue] -> Text
returnExpression 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
_value) -> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i)
                [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
"svt.validateOneOfLiterals<", Text
name, Text
">(value, ", Text
"[", Text
valuesOutput, Text
"])"]
      returnType :: a -> a
returnType a
name = a
"svt.ValidationResult<" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
name a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
">"
   in FunctionPrefix
-> ReturnType
-> (Text -> [EnumerationValue] -> Text)
-> Text
-> [EnumerationValue]
-> Text
outputEnumerationFunction (Text -> FunctionPrefix
FunctionPrefix Text
"validate") ((Text -> Text) -> ReturnType
ReturnType Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
returnType) Text -> [EnumerationValue] -> Text
returnExpression

outputPlainStruct :: Text -> [StructField] -> Text
outputPlainStruct :: Text -> [StructField] -> Text
outputPlainStruct Text
name [StructField]
fields =
  let export :: Text
export = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"export type ", Text
name, Text
" = {\n"]
      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 StructField -> Text
outputField [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      typeGuardOutput :: Text
typeGuardOutput = Text -> [StructField] -> [TypeVariable] -> Text
outputStructTypeGuard Text
name [StructField]
fields []
      validatorOutput :: Text
validatorOutput = Text -> [StructField] -> [TypeVariable] -> Text
outputStructValidator Text
name [StructField]
fields []
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
export, Text
fieldsOutput, Text
"};\n\n", Text
typeGuardOutput, Text
"\n\n", Text
validatorOutput]

outputGenericStruct :: Text -> [TypeVariable] -> [StructField] -> Text
outputGenericStruct :: Text -> [TypeVariable] -> [StructField] -> Text
outputGenericStruct Text
name [TypeVariable]
typeVariables [StructField]
fields =
  let fullName :: Text
fullName = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables
      typeOutput :: Text
typeOutput =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"export type ", Text
fullName, Text
" = {\n"],
            Text
fieldsOutput,
            Text
"};"
          ]
      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 StructField -> Text
outputField [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      typeGuardOutput :: Text
typeGuardOutput = Text -> [StructField] -> [TypeVariable] -> Text
outputStructTypeGuard Text
name [StructField]
fields [TypeVariable]
typeVariables
      validatorOutput :: Text
validatorOutput = Text -> [StructField] -> [TypeVariable] -> Text
outputStructValidator Text
name [StructField]
fields [TypeVariable]
typeVariables
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
typeOutput, Text
"\n\n", Text
typeGuardOutput, Text
"\n\n", Text
validatorOutput]

outputStructValidator :: Text -> [StructField] -> [TypeVariable] -> Text
outputStructValidator :: Text -> [StructField] -> [TypeVariable] -> Text
outputStructValidator Text
name [StructField]
fields [TypeVariable]
typeVariables =
  let interface :: Text
interface =
        Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([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 -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
   in if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
        then
          [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
"export function validate",
                      Text
name,
                      Text
"(value: unknown): svt.ValidationResult<",
                      Text
name,
                      Text
"> {\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return svt.validate<", Text
name, Text
">(value, ", Text
interface, Text
");\n"]
                ],
              Text
"}"
            ]
        else
          let fullName :: Text
fullName = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables
              returnedFunctionName :: Text
returnedFunctionName =
                (Text
"validate" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fullName) Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> Text -> Text
Text.filter ((Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"<>, " :: String)) (Char -> Bool) -> (Bool -> Bool) -> Char -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Bool -> Bool
not)
           in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"export function validate",
                      Text
fullName,
                      Text
"(",
                      [TypeVariable] -> Text
typeVariableValidatorParameters [TypeVariable]
typeVariables,
                      Text
"): svt.Validator<",
                      Text
fullName,
                      Text
"> {\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"    return function ",
                      Text
returnedFunctionName,
                      Text
"(value: unknown): svt.ValidationResult<",
                      Text
fullName,
                      Text
"> {\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"        return svt.validate<",
                      Text
fullName,
                      Text
">(value, ",
                      Text
interface,
                      Text
");\n"
                    ],
                  Text
"    };\n",
                  Text
"}"
                ]

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

outputValidatorForFieldType :: FieldType -> Text
outputValidatorForFieldType :: FieldType -> Text
outputValidatorForFieldType (LiteralType (LiteralString Text
text)) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"\"", Text
text, Text
"\""]
outputValidatorForFieldType (LiteralType (LiteralInteger Integer
x)) = Integer -> Text
forall a. Show a => a -> Text
tshow Integer
x
outputValidatorForFieldType (LiteralType (LiteralFloat Float
f)) = Float -> Text
forall a. Show a => a -> Text
tshow Float
f
outputValidatorForFieldType (LiteralType (LiteralBoolean Bool
b)) = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
b
outputValidatorForFieldType (BasicType BasicTypeValue
basicType) = BasicTypeValue -> Text
outputValidatorForBasicType BasicTypeValue
basicType
outputValidatorForFieldType (ComplexType ComplexTypeValue
complexType) = ComplexTypeValue -> Text
outputValidatorForComplexType ComplexTypeValue
complexType
outputValidatorForFieldType (DefinitionReferenceType DefinitionReference
definitionReference) =
  DefinitionReference -> Text
outputValidatorForDefinitionReference DefinitionReference
definitionReference
outputValidatorForFieldType (RecursiveReferenceType (DefinitionName Text
name)) = Text
"validate" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
outputValidatorForFieldType (TypeVariableReferenceType (TypeVariable Text
name)) = Text
"validate" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

outputValidatorForDefinitionReference :: DefinitionReference -> Text
outputValidatorForDefinitionReference :: DefinitionReference -> Text
outputValidatorForDefinitionReference
  ( DefinitionReference
      ( TypeDefinition
          (DefinitionName Text
name)
          (DeclaredType (ModuleName Text
moduleName) [TypeVariable]
_appliedTypes)
        )
    ) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".validate", Text -> Text
upperCaseFirstCharacter Text
name]
outputValidatorForDefinitionReference (DefinitionReference (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)) =
  Text
"validate" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
outputValidatorForDefinitionReference
  ( ImportedDefinitionReference
      (ModuleName Text
moduleName)
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".validate", Text
name]
outputValidatorForDefinitionReference
  ( AppliedGenericReference
      [FieldType]
appliedTypes
      ( TypeDefinition
          (DefinitionName Text
name)
          ( DeclaredType
              (ModuleName Text
moduleName)
              [TypeVariable]
_appliedTypes
            )
        )
    ) =
    let appliedValidators :: Text
appliedValidators = [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
outputValidatorForFieldType [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
".validate", Text
name, Text
"(", Text
appliedValidators, Text
")"]
outputValidatorForDefinitionReference
  ( AppliedGenericReference
      [FieldType]
appliedTypes
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    let appliedValidators :: Text
appliedValidators = [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
outputValidatorForFieldType [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
"validate", Text
name, Text
"(", Text
appliedValidators, Text
")"]
outputValidatorForDefinitionReference
  ( AppliedImportedGenericReference
      (ModuleName Text
moduleName)
      (AppliedTypes [FieldType]
appliedTypes)
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    let appliedValidators :: Text
appliedValidators = [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
outputValidatorForFieldType [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
".validate", Text
name, Text
"(", Text
appliedValidators, Text
")"]
outputValidatorForDefinitionReference
  ( GenericDeclarationReference
      (ModuleName Text
moduleName)
      (DefinitionName Text
name)
      (AppliedTypes [FieldType]
appliedTypes)
    ) =
    let appliedValidators :: Text
appliedValidators = [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
outputValidatorForFieldType [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
        maybeAppliedTypes :: Text
maybeAppliedTypes = 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
appliedValidators, Text
")"]
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".validate", Text -> Text
upperCaseFirstCharacter Text
name, Text
maybeAppliedTypes]
outputValidatorForDefinitionReference
  (DeclarationReference (ModuleName Text
moduleName) (DefinitionName Text
name)) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".validate", Text -> Text
upperCaseFirstCharacter Text
name]

outputValidatorForBasicType :: BasicTypeValue -> Text
outputValidatorForBasicType :: BasicTypeValue -> Text
outputValidatorForBasicType BasicTypeValue
BasicString = Text
"svt.validateString"
outputValidatorForBasicType BasicTypeValue
U8 = Text
"svt.validateNumber"
outputValidatorForBasicType BasicTypeValue
U16 = Text
"svt.validateNumber"
outputValidatorForBasicType BasicTypeValue
U32 = Text
"svt.validateNumber"
outputValidatorForBasicType BasicTypeValue
U64 = Text
"svt.validateBigInt"
outputValidatorForBasicType BasicTypeValue
U128 = Text
"svt.validateBigInt"
outputValidatorForBasicType BasicTypeValue
I8 = Text
"svt.validateNumber"
outputValidatorForBasicType BasicTypeValue
I16 = Text
"svt.validateNumber"
outputValidatorForBasicType BasicTypeValue
I32 = Text
"svt.validateNumber"
outputValidatorForBasicType BasicTypeValue
I64 = Text
"svt.validateBigInt"
outputValidatorForBasicType BasicTypeValue
I128 = Text
"svt.validateBigInt"
outputValidatorForBasicType BasicTypeValue
F32 = Text
"svt.validateNumber"
outputValidatorForBasicType BasicTypeValue
F64 = Text
"svt.validateNumber"
outputValidatorForBasicType BasicTypeValue
Boolean = Text
"svt.validateBoolean"

outputValidatorForComplexType :: ComplexTypeValue -> Text
outputValidatorForComplexType :: ComplexTypeValue -> Text
outputValidatorForComplexType (ArrayType Integer
_size FieldType
typeData) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"svt.validateArray(", FieldType -> Text
outputValidatorForFieldType FieldType
typeData, Text
")"]
outputValidatorForComplexType (SliceType FieldType
typeData) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"svt.validateArray(", FieldType -> Text
outputValidatorForFieldType FieldType
typeData, Text
")"]
outputValidatorForComplexType (PointerType FieldType
typeData) =
  FieldType -> Text
outputValidatorForFieldType FieldType
typeData
outputValidatorForComplexType (OptionalType FieldType
typeData) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"svt.validateOptional(", FieldType -> Text
outputValidatorForFieldType FieldType
typeData, Text
")"]

outputStructTypeGuard :: Text -> [StructField] -> [TypeVariable] -> Text
outputStructTypeGuard :: Text -> [StructField] -> [TypeVariable] -> Text
outputStructTypeGuard Text
name [StructField]
fields [TypeVariable]
typeVariables =
  let interface :: Text
interface =
        Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([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
outputStructTypeGuardForField [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
   in if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
        then
          [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
"export function is", Text
name, Text
"(value: unknown): value is ", Text
name, Text
" {\n"],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return svt.isInterface<", Text
name, Text
">(value, ", Text
interface, Text
");\n"]
                ],
              Text
"}"
            ]
        else
          let fullName :: Text
fullName = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables
              returnedFunctionName :: Text
returnedFunctionName =
                (Text
"is" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fullName) Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> Text -> Text
Text.filter ((Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"<>, " :: String)) (Char -> Bool) -> (Bool -> Bool) -> Char -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Bool -> Bool
not)
           in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"export function is",
                      Text
fullName,
                      Text
"(",
                      [TypeVariable] -> Text
typeVariablePredicateParameters [TypeVariable]
typeVariables,
                      Text
"): svt.TypePredicate<",
                      Text
fullName,
                      Text
"> {\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"    return function ",
                      Text
returnedFunctionName,
                      Text
"(value: unknown): value is ",
                      Text
fullName,
                      Text
" {\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"        return svt.isInterface<",
                      Text
fullName,
                      Text
">(value, ",
                      Text
interface,
                      Text
");\n"
                    ],
                  Text
"    };\n",
                  Text
"}"
                ]

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

outputTypeGuardForFieldType :: FieldType -> Text
outputTypeGuardForFieldType :: FieldType -> Text
outputTypeGuardForFieldType (LiteralType (LiteralString Text
text)) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"\"", Text
text, Text
"\""]
outputTypeGuardForFieldType (LiteralType (LiteralInteger Integer
x)) = Integer -> Text
forall a. Show a => a -> Text
tshow Integer
x
outputTypeGuardForFieldType (LiteralType (LiteralFloat Float
f)) = Float -> Text
forall a. Show a => a -> Text
tshow Float
f
outputTypeGuardForFieldType (LiteralType (LiteralBoolean Bool
b)) = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
b
outputTypeGuardForFieldType (BasicType BasicTypeValue
basicType) = BasicTypeValue -> Text
outputTypeGuardForBasicType BasicTypeValue
basicType
outputTypeGuardForFieldType (ComplexType ComplexTypeValue
complexType) = ComplexTypeValue -> Text
outputTypeGuardForComplexType ComplexTypeValue
complexType
outputTypeGuardForFieldType (DefinitionReferenceType DefinitionReference
definitionReference) =
  DefinitionReference -> Text
outputTypeGuardForDefinitionReference DefinitionReference
definitionReference
outputTypeGuardForFieldType (RecursiveReferenceType (DefinitionName Text
name)) = Text
"is" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
outputTypeGuardForFieldType (TypeVariableReferenceType (TypeVariable Text
name)) = Text
"is" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

outputTypeGuardForDefinitionReference :: DefinitionReference -> Text
outputTypeGuardForDefinitionReference :: DefinitionReference -> Text
outputTypeGuardForDefinitionReference (DefinitionReference (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)) =
  Text
"is" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
outputTypeGuardForDefinitionReference
  ( ImportedDefinitionReference
      (ModuleName Text
moduleName)
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".is", Text
name]
outputTypeGuardForDefinitionReference
  ( AppliedGenericReference
      [FieldType]
appliedTypes
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    let appliedTypeGuards :: Text
appliedTypeGuards = [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
outputTypeGuardForFieldType [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
"is", Text
name, Text
"(", Text
appliedTypeGuards, Text
")"]
outputTypeGuardForDefinitionReference
  ( AppliedImportedGenericReference
      (ModuleName Text
moduleName)
      (AppliedTypes [FieldType]
appliedTypes)
      (TypeDefinition (DefinitionName Text
name) TypeData
_typeData)
    ) =
    let appliedTypeGuards :: Text
appliedTypeGuards = [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
outputTypeGuardForFieldType [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
".is", Text
name, Text
"(", Text
appliedTypeGuards, Text
")"]
outputTypeGuardForDefinitionReference
  ( GenericDeclarationReference
      (ModuleName Text
moduleName)
      (DefinitionName Text
name)
      (AppliedTypes [FieldType]
appliedTypes)
    ) =
    let appliedTypeGuards :: Text
appliedTypeGuards = [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
outputTypeGuardForFieldType [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
        maybeAppliedTypes :: Text
maybeAppliedTypes = 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
appliedTypeGuards, Text
")"]
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".is", Text -> Text
upperCaseFirstCharacter Text
name, Text
maybeAppliedTypes]
outputTypeGuardForDefinitionReference
  (DeclarationReference (ModuleName Text
moduleName) (DefinitionName Text
name)) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
moduleName, Text
".is", Text -> Text
upperCaseFirstCharacter Text
name]

outputTypeGuardForBasicType :: BasicTypeValue -> Text
outputTypeGuardForBasicType :: BasicTypeValue -> Text
outputTypeGuardForBasicType BasicTypeValue
BasicString = Text
"svt.isString"
outputTypeGuardForBasicType BasicTypeValue
U8 = Text
"svt.isNumber"
outputTypeGuardForBasicType BasicTypeValue
U16 = Text
"svt.isNumber"
outputTypeGuardForBasicType BasicTypeValue
U32 = Text
"svt.isNumber"
outputTypeGuardForBasicType BasicTypeValue
U64 = Text
"svt.isBigInt"
outputTypeGuardForBasicType BasicTypeValue
U128 = Text
"svt.isBigInt"
outputTypeGuardForBasicType BasicTypeValue
I8 = Text
"svt.isNumber"
outputTypeGuardForBasicType BasicTypeValue
I16 = Text
"svt.isNumber"
outputTypeGuardForBasicType BasicTypeValue
I32 = Text
"svt.isNumber"
outputTypeGuardForBasicType BasicTypeValue
I64 = Text
"svt.isBigInt"
outputTypeGuardForBasicType BasicTypeValue
I128 = Text
"svt.isBigInt"
outputTypeGuardForBasicType BasicTypeValue
F32 = Text
"svt.isNumber"
outputTypeGuardForBasicType BasicTypeValue
F64 = Text
"svt.isNumber"
outputTypeGuardForBasicType BasicTypeValue
Boolean = Text
"svt.isBoolean"

outputTypeGuardForComplexType :: ComplexTypeValue -> Text
outputTypeGuardForComplexType :: ComplexTypeValue -> Text
outputTypeGuardForComplexType (ArrayType Integer
_size FieldType
typeData) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"svt.arrayOf(", FieldType -> Text
outputTypeGuardForFieldType FieldType
typeData, Text
")"]
outputTypeGuardForComplexType (SliceType FieldType
typeData) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"svt.arrayOf(", FieldType -> Text
outputTypeGuardForFieldType FieldType
typeData, Text
")"]
outputTypeGuardForComplexType (PointerType FieldType
typeData) =
  FieldType -> Text
outputTypeGuardForFieldType FieldType
typeData
outputTypeGuardForComplexType (OptionalType FieldType
typeData) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"svt.optional(", FieldType -> Text
outputTypeGuardForFieldType FieldType
typeData, Text
")"]

outputUnion :: Text -> FieldName -> UnionType -> Text
outputUnion :: Text -> FieldName -> UnionType -> Text
outputUnion Text
name FieldName
typeTag UnionType
unionType =
  let caseUnionOutput :: Text
caseUnionOutput = Text -> [Constructor] -> [TypeVariable] -> Text
outputCaseUnion Text
name (UnionType -> [Constructor]
constructorsFrom UnionType
unionType) [TypeVariable]
typeVariables
      constructorsFrom :: UnionType -> [Constructor]
constructorsFrom (PlainUnion [Constructor]
constructors) = [Constructor]
constructors
      constructorsFrom (GenericUnion [TypeVariable]
_typeVariables [Constructor]
constructors) = [Constructor]
constructors
      unionTagEnumerationOutput :: Text
unionTagEnumerationOutput = Text -> [Constructor] -> Text
outputUnionTagEnumeration Text
name (UnionType -> [Constructor]
constructorsFrom UnionType
unionType)
      caseTypesOutput :: Text
caseTypesOutput = Text -> FieldName -> [Constructor] -> Text
outputCaseTypes Text
name FieldName
typeTag (UnionType -> [Constructor]
constructorsFrom UnionType
unionType)
      caseConstructorOutput :: Text
caseConstructorOutput = Text -> FieldName -> [Constructor] -> Text
outputCaseConstructors Text
name FieldName
typeTag (UnionType -> [Constructor]
constructorsFrom UnionType
unionType)
      unionTypeGuardOutput :: Text
unionTypeGuardOutput = FieldName -> [TypeVariable] -> Text -> [Constructor] -> Text
outputUnionTypeGuard FieldName
typeTag [TypeVariable]
typeVariables Text
name (UnionType -> [Constructor]
constructorsFrom UnionType
unionType)
      caseTypeGuardOutput :: Text
caseTypeGuardOutput = Text -> FieldName -> [Constructor] -> Text
outputCaseTypeGuards Text
name FieldName
typeTag (UnionType -> [Constructor]
constructorsFrom UnionType
unionType)
      unionValidatorOutput :: Text
unionValidatorOutput =
        [TypeVariable] -> FieldName -> Text -> [Constructor] -> Text
outputUnionValidator [TypeVariable]
typeVariables FieldName
typeTag Text
name (UnionType -> [Constructor]
constructorsFrom UnionType
unionType)
      caseValidatorOutput :: Text
caseValidatorOutput = FieldName -> Text -> [Constructor] -> Text
outputCaseValidators FieldName
typeTag Text
name (UnionType -> [Constructor]
constructorsFrom UnionType
unionType)
      typeVariables :: [TypeVariable]
typeVariables = case UnionType
unionType of
        PlainUnion [Constructor]
_constructors -> []
        GenericUnion [TypeVariable]
ts [Constructor]
_constructors -> [TypeVariable]
ts
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
caseUnionOutput,
          Text
"\n\n",
          Text
unionTagEnumerationOutput,
          Text
"\n\n",
          Text
caseTypesOutput,
          Text
"\n\n",
          Text
caseConstructorOutput,
          Text
"\n\n",
          Text
unionTypeGuardOutput,
          Text
"\n\n",
          Text
caseTypeGuardOutput,
          Text
"\n\n",
          Text
unionValidatorOutput,
          Text
"\n\n",
          Text
caseValidatorOutput
        ]

newtype FunctionPrefix = FunctionPrefix Text

newtype ReturnType = ReturnType (Text -> Text)

newtype ReturnExpression = ReturnExpression (Text -> FieldName -> [Constructor] -> Text)

outputUnionFunction ::
  FunctionPrefix ->
  ReturnType ->
  ReturnExpression ->
  FieldName ->
  Text ->
  [Constructor] ->
  Text
outputUnionFunction :: FunctionPrefix
-> ReturnType
-> ReturnExpression
-> FieldName
-> Text
-> [Constructor]
-> Text
outputUnionFunction
  (FunctionPrefix Text
prefix)
  (ReturnType Text -> Text
returnType)
  (ReturnExpression Text -> FieldName -> [Constructor] -> Text
returnExpression)
  FieldName
typeTag
  Text
unionName
  [Constructor]
constructors =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"export function ",
            Text
prefix,
            Text
unionName,
            Text
"(value: unknown): ",
            Text -> Text
returnType Text
unionName,
            Text
" {\n"
          ],
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return ", Text -> FieldName -> [Constructor] -> Text
returnExpression Text
unionName FieldName
typeTag [Constructor]
constructors, Text
";\n"],
        Text
"}"
      ]

outputUnionTypeGuard :: FieldName -> [TypeVariable] -> Text -> [Constructor] -> Text
outputUnionTypeGuard :: FieldName -> [TypeVariable] -> Text -> [Constructor] -> Text
outputUnionTypeGuard FieldName
typeTag [TypeVariable]
typeVariables Text
unionName [Constructor]
constructors =
  if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
    then
      let returnExpression :: p -> p -> [Constructor] -> Text
returnExpression p
_unionName' p
_tagType [Constructor]
constructors' =
            let constructorTypeGuards :: Text
constructorTypeGuards =
                  [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
_payload) ->
                          Text
"is" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
upperCaseFirstCharacter Text
constructorName
                      )
                    [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
constructorTypeGuards, Text
"].some((typePredicate) => typePredicate(value))"]
       in FunctionPrefix
-> ReturnType
-> ReturnExpression
-> FieldName
-> Text
-> [Constructor]
-> Text
outputUnionFunction
            (Text -> FunctionPrefix
FunctionPrefix Text
"is")
            ((Text -> Text) -> ReturnType
ReturnType (Text
"value is " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>))
            ((Text -> FieldName -> [Constructor] -> Text) -> ReturnExpression
ReturnExpression Text -> FieldName -> [Constructor] -> Text
forall p p. p -> p -> [Constructor] -> Text
returnExpression)
            FieldName
typeTag
            Text
unionName
            [Constructor]
constructors
    else
      let fullName :: Text
fullName = Text
unionName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables
          typeVariablePredicates :: Text
typeVariablePredicates =
            [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
"is", Text
t, Text
": svt.TypePredicate<", Text
t, Text
">"])
              [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
          returnedFunctionName :: Text
returnedFunctionName = Text
"is" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
Text.filter ((Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"<>, " :: String)) (Char -> Bool) -> (Bool -> Bool) -> Char -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Bool -> Bool
not) Text
fullName
          constructorPredicates :: Text
constructorPredicates =
            [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
name) Maybe FieldType
maybePayload) ->
                    let constructorTypeVariables :: [TypeVariable]
constructorTypeVariables =
                          [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
                        maybeParameters :: Text
maybeParameters =
                          if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
constructorTypeVariables
                            then Text
""
                            else Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
predicates Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
                        predicates :: Text
predicates =
                          [TypeVariable]
constructorTypeVariables
                            [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
"is" 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
", "
                     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"is", Text -> Text
upperCaseFirstCharacter Text
name, Text
maybeParameters]
                )
              [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
"export function is",
                  Text
fullName,
                  Text
"(",
                  Text
typeVariablePredicates,
                  Text
"): svt.TypePredicate<",
                  Text
fullName,
                  Text
"> {\n"
                ],
              [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"    return function ",
                  Text
returnedFunctionName,
                  Text
"(value: unknown): value is ",
                  Text
fullName,
                  Text
" {\n"
                ],
              [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"        return [",
                  Text
constructorPredicates,
                  Text
"].some((typePredicate) => typePredicate(value));\n"
                ],
              Text
"    };\n",
              Text
"}"
            ]

outputUnionValidator :: [TypeVariable] -> FieldName -> Text -> [Constructor] -> Text
outputUnionValidator :: [TypeVariable] -> FieldName -> Text -> [Constructor] -> Text
outputUnionValidator [TypeVariable]
typeVariables typeTag :: FieldName
typeTag@(FieldName Text
tag) Text
unionName [Constructor]
constructors =
  let constructorTagValidators :: Text
constructorTagValidators =
        [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 tagName :: Text
tagName = Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
constructorName
                    constructorTypeVariables :: [TypeVariable]
constructorTypeVariables = [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
                    name :: Text
name =
                      if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
constructorTypeVariables
                        then Text
constructorName
                        else
                          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                            [ Text
constructorName,
                              Text
"(",
                              [TypeVariable] -> Text
typeVariableValidatorNames [TypeVariable]
constructorTypeVariables,
                              Text
")"
                            ]
                 in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"[", Text
tagName, Text
"]: ", Text
"validate", Text -> Text
upperCaseFirstCharacter Text
name]
            )
          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
   in if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
        then
          let returnExpression :: Text -> FieldName -> [Constructor] -> Text
returnExpression Text
unionName' (FieldName Text
tag') [Constructor]
_constructors' =
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ Text
"svt.validateWithTypeTag<",
                    Text
unionName',
                    Text
">(value, {",
                    Text
constructorTagValidators,
                    Text
"}, \"",
                    Text
tag',
                    Text
"\")"
                  ]
           in FunctionPrefix
-> ReturnType
-> ReturnExpression
-> FieldName
-> Text
-> [Constructor]
-> Text
outputUnionFunction
                (Text -> FunctionPrefix
FunctionPrefix Text
"validate")
                ((Text -> Text) -> ReturnType
ReturnType (\Text
n -> Text
"svt.ValidationResult<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"))
                ((Text -> FieldName -> [Constructor] -> Text) -> ReturnExpression
ReturnExpression Text -> FieldName -> [Constructor] -> Text
returnExpression)
                FieldName
typeTag
                Text
unionName
                [Constructor]
constructors
        else
          let fullName :: Text
fullName = Text
unionName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables
              returnedFunctionName :: Text
returnedFunctionName =
                Text
"validate" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
Text.filter ((Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"<>, " :: String)) (Char -> Bool) -> (Bool -> Bool) -> Char -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Bool -> Bool
not) Text
fullName
           in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"export function validate",
                      Text
fullName,
                      Text
"(",
                      [TypeVariable] -> Text
typeVariableValidatorParameters [TypeVariable]
typeVariables,
                      Text
"): svt.Validator<",
                      Text
fullName,
                      Text
"> {\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"    return function ",
                      Text
returnedFunctionName,
                      Text
"(value: unknown): svt.ValidationResult<",
                      Text
fullName,
                      Text
"> {\n"
                    ],
                  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                    [ Text
"        return svt.validateWithTypeTag<",
                      Text
fullName,
                      Text
">(value, {",
                      Text
constructorTagValidators,
                      Text
"}, \"",
                      Text
tag,
                      Text
"\");\n"
                    ],
                  Text
"    };\n",
                  Text
"}"
                ]

outputCaseTypeGuards :: Text -> FieldName -> [Constructor] -> Text
outputCaseTypeGuards :: Text -> FieldName -> [Constructor] -> Text
outputCaseTypeGuards Text
unionName FieldName
typeTag =
  (Constructor -> Text) -> [Constructor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FieldName -> Constructor -> Text
outputCaseTypeGuard Text
unionName FieldName
typeTag) ([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"

outputCaseTypeGuard :: Text -> FieldName -> Constructor -> Text
outputCaseTypeGuard :: Text -> FieldName -> Constructor -> Text
outputCaseTypeGuard
  Text
unionName
  (FieldName Text
tag)
  (Constructor (ConstructorName Text
name) Maybe FieldType
maybePayload) =
    let tagValue :: Text
tagValue = Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name
        typeVariables :: [TypeVariable]
typeVariables = [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
        interface :: Text
interface =
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
            [Text
"{", Text
tag, Text
": ", Text
tagValue]
              [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> (FieldType -> [Text]) -> Maybe FieldType -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text
"}"] (\FieldType
p -> [Text
", data: ", FieldType -> Text
outputTypeGuardForFieldType FieldType
p, Text
"}"]) Maybe FieldType
maybePayload
     in if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"export function is", Text -> Text
upperCaseFirstCharacter Text
name, Text
"(value: unknown): value is ", Text
name, Text
" {\n"],
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return svt.isInterface<", Text
name, Text
">(value, ", Text
interface, Text
");\n"],
                Text
"}"
              ]
          else
            let fullName :: Text
fullName = Text -> Text
upperCaseFirstCharacter Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables
                returnedFunctionName :: Text
returnedFunctionName = Text
"is" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
Text.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>') Text
fullName
             in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                      [ Text
"export function is",
                        Text
fullName,
                        Text
"(",
                        [TypeVariable] -> Text
typeVariablePredicateParameters [TypeVariable]
typeVariables,
                        Text
"): svt.TypePredicate<",
                        Text
fullName,
                        Text
"> {\n"
                      ],
                    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                      [ Text
"    return function ",
                        Text
returnedFunctionName,
                        Text
"(value: unknown): value is ",
                        Text
fullName,
                        Text
" {\n"
                      ],
                    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                      [ Text
"        return svt.isInterface<",
                        Text
fullName,
                        Text
">(value, ",
                        Text
interface,
                        Text
");\n"
                      ],
                    Text
"    };\n",
                    Text
"}"
                  ]

typeVariablePredicateParameters :: [TypeVariable] -> Text
typeVariablePredicateParameters :: [TypeVariable] -> Text
typeVariablePredicateParameters =
  (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
"is", Text
t, Text
": svt.TypePredicate<", Text
t, Text
">"])
    ([TypeVariable] -> [Text])
-> ([Text] -> 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
>>> Text -> [Text] -> Text
Text.intercalate Text
", "

typeVariableValidatorNames :: [TypeVariable] -> Text
typeVariableValidatorNames :: [TypeVariable] -> Text
typeVariableValidatorNames =
  (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) ([TypeVariable] -> [Text])
-> ([Text] -> 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
>>> Text -> [Text] -> Text
Text.intercalate Text
", "

typeVariableValidatorParameters :: [TypeVariable] -> Text
typeVariableValidatorParameters :: [TypeVariable] -> Text
typeVariableValidatorParameters =
  (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
t, Text
": svt.Validator<", Text
t, Text
">"])
    ([TypeVariable] -> [Text])
-> ([Text] -> 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
>>> Text -> [Text] -> Text
Text.intercalate Text
", "

outputCaseValidators :: FieldName -> Text -> [Constructor] -> Text
outputCaseValidators :: FieldName -> Text -> [Constructor] -> Text
outputCaseValidators FieldName
typeTag Text
unionName =
  (Constructor -> Text) -> [Constructor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldName -> Text -> Constructor -> Text
outputCaseValidator FieldName
typeTag Text
unionName) ([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"

outputCaseValidator :: FieldName -> Text -> Constructor -> Text
outputCaseValidator :: FieldName -> Text -> Constructor -> Text
outputCaseValidator
  (FieldName Text
tag)
  Text
unionName
  (Constructor (ConstructorName Text
name) Maybe FieldType
maybePayload) =
    let tagValue :: Text
tagValue = Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name
        typeVariables :: [TypeVariable]
typeVariables = [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
        interface :: Text
interface =
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
            [Text
"{", Text
tag, Text
": ", Text
tagValue]
              [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> (FieldType -> [Text]) -> Maybe FieldType -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text
"}"] (\FieldType
p -> [Text
", data: ", FieldType -> Text
outputValidatorForFieldType FieldType
p, Text
"}"]) Maybe FieldType
maybePayload
     in if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables
          then
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ Text
"export function validate",
                    Text -> Text
upperCaseFirstCharacter Text
name,
                    Text
"(value: unknown): svt.ValidationResult<",
                    Text
name,
                    Text
"> {\n"
                  ],
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    return svt.validate<", Text
name, Text
">(value, ", Text
interface, Text
");\n"],
                Text
"}"
              ]
          else
            let fullName :: Text
fullName = Text -> Text
upperCaseFirstCharacter Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables
                returnedFunctionName :: Text
returnedFunctionName = Text
"validate" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
Text.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>') Text
fullName
             in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                      [ Text
"export function validate",
                        Text
fullName,
                        Text
"(",
                        [TypeVariable] -> Text
typeVariableValidatorParameters [TypeVariable]
typeVariables,
                        Text
"): svt.Validator<",
                        Text
fullName,
                        Text
"> {\n"
                      ],
                    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                      [ Text
"    return function ",
                        Text
returnedFunctionName,
                        Text
"(value: unknown): svt.ValidationResult<",
                        Text
fullName,
                        Text
"> {\n"
                      ],
                    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                      [ Text
"        return svt.validate<",
                        Text
fullName,
                        Text
">(value, ",
                        Text
interface,
                        Text
");\n"
                      ],
                    Text
"    };\n",
                    Text
"}"
                  ]

outputCaseUnion :: Text -> [Constructor] -> [TypeVariable] -> Text
outputCaseUnion :: Text -> [Constructor] -> [TypeVariable] -> Text
outputCaseUnion Text
name [Constructor]
constructors [TypeVariable]
typeVariables =
  let cases :: Text
cases =
        [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) ->
                ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text -> Text
upperCaseFirstCharacter Text
constructorName])
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (FieldType -> Text) -> Maybe FieldType -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    Text
""
                    (FieldType -> Maybe [TypeVariable]
typeVariablesFrom (FieldType -> Maybe [TypeVariable])
-> (Maybe [TypeVariable] -> 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
>>> Maybe [TypeVariable] -> Text
maybeJoinTypeVariables)
                    Maybe FieldType
maybePayload
            )
          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
" | "
      maybeTypeVariables :: Text
maybeTypeVariables = if [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeVariable]
typeVariables then Text
"" else [TypeVariable] -> Text
joinTypeVariables [TypeVariable]
typeVariables
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"export type ", Text
name, Text
maybeTypeVariables, Text
" = ", Text
cases, Text
";"]

outputUnionTagEnumeration :: Text -> [Constructor] -> Text
outputUnionTagEnumeration :: Text -> [Constructor] -> Text
outputUnionTagEnumeration Text
name [Constructor]
constructors =
  let constructorCasesOutput :: Text
constructorCasesOutput =
        [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
_payload) ->
                [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    ", Text -> Text
upperCaseFirstCharacter Text
constructorName, Text
" = \"", Text
constructorName, Text
"\",\n"]
            )
          [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
"export enum ", Text
name, Text
"Tag {\n"],
          Text
constructorCasesOutput,
          Text
"}"
        ]

outputCaseTypes :: Text -> FieldName -> [Constructor] -> Text
outputCaseTypes :: Text -> FieldName -> [Constructor] -> Text
outputCaseTypes Text
unionName FieldName
typeTag [Constructor]
constructors =
  [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 (Text -> FieldName -> Constructor -> Text
outputCaseType Text
unionName FieldName
typeTag)
    [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n\n"

outputCaseType :: Text -> FieldName -> Constructor -> Text
outputCaseType :: Text -> FieldName -> Constructor -> Text
outputCaseType
  Text
unionName
  (FieldName Text
tag)
  (Constructor (ConstructorName Text
name) Maybe FieldType
maybePayload) =
    let payloadLine :: Text
payloadLine = Text -> (FieldType -> Text) -> Maybe FieldType -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\FieldType
p -> Text
"    data: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldType -> Text
outputFieldType FieldType
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";\n") Maybe FieldType
maybePayload
        maybeTypeVariables :: Text
maybeTypeVariables = Text -> (FieldType -> Text) -> Maybe FieldType -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (FieldType -> Maybe [TypeVariable]
typeVariablesFrom (FieldType -> Maybe [TypeVariable])
-> (Maybe [TypeVariable] -> 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
>>> Maybe [TypeVariable] -> Text
maybeJoinTypeVariables) Maybe FieldType
maybePayload
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"export type ", Text -> Text
upperCaseFirstCharacter Text
name, Text
maybeTypeVariables, Text
" = {\n"],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    ", Text
tag, Text
": ", Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name, Text
";\n"],
            Text
payloadLine,
            Text
"};"
          ]

outputCaseConstructors :: Text -> FieldName -> [Constructor] -> Text
outputCaseConstructors :: Text -> FieldName -> [Constructor] -> Text
outputCaseConstructors Text
unionName FieldName
typeTag [Constructor]
constructors =
  [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 (Text -> FieldName -> Constructor -> Text
outputCaseConstructor Text
unionName FieldName
typeTag)
    [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"\n\n"

outputCaseConstructor :: Text -> FieldName -> Constructor -> Text
outputCaseConstructor :: Text -> FieldName -> Constructor -> Text
outputCaseConstructor
  Text
unionName
  (FieldName Text
tag)
  (Constructor (ConstructorName Text
name) Maybe FieldType
maybePayload) =
    let argumentFieldAndType :: Text
argumentFieldAndType = Text -> (FieldType -> Text) -> Maybe FieldType -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\FieldType
p -> Text
"data: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldType -> Text
outputFieldType FieldType
p) Maybe FieldType
maybePayload
        maybeTypeVariables :: Text
maybeTypeVariables = Text -> ([TypeVariable] -> Text) -> Maybe [TypeVariable] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" [TypeVariable] -> Text
joinTypeVariables (Maybe FieldType
maybePayload Maybe FieldType
-> (FieldType -> Maybe [TypeVariable]) -> Maybe [TypeVariable]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldType -> Maybe [TypeVariable]
typeVariablesFrom)
     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"export function ",
                Text
name,
                Text
maybeTypeVariables,
                Text
"(",
                Text
argumentFieldAndType,
                Text
"): ",
                Text
name,
                Text
maybeTypeVariables,
                Text
" {\n"
              ],
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              ( [ Text
"    return {",
                  Text
tag,
                  Text
": ",
                  Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
name
                ]
                  [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> (FieldType -> [Text]) -> Maybe FieldType -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([Text] -> FieldType -> [Text]
forall a b. a -> b -> a
const [Text
", data"]) Maybe FieldType
maybePayload
              )
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"};\n",
            Text
"}"
          ]

unionEnumConstructorTag :: Text -> Text -> Text
unionEnumConstructorTag :: Text -> Text -> Text
unionEnumConstructorTag Text
unionName Text
constructorName =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
unionName, Text
"Tag.", Text -> Text
upperCaseFirstCharacter Text
constructorName]

outputField :: StructField -> Text
outputField :: StructField -> Text
outputField (StructField (FieldName Text
name) FieldType
fieldType) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"    ", Text
name, Text
": ", FieldType -> Text
outputFieldType FieldType
fieldType, Text
";\n"]

outputFieldType :: FieldType -> Text
outputFieldType :: FieldType -> Text
outputFieldType (LiteralType (LiteralString Text
text)) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"\"", Text
text, Text
"\""]
outputFieldType (LiteralType (LiteralInteger Integer
x)) = Integer -> Text
forall a. Show a => a -> Text
tshow Integer
x
outputFieldType (LiteralType (LiteralFloat Float
f)) = Float -> Text
forall a. Show a => a -> Text
tshow Float
f
outputFieldType (LiteralType (LiteralBoolean Bool
b)) = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
b
outputFieldType (BasicType BasicTypeValue
basicType) = BasicTypeValue -> Text
outputBasicType BasicTypeValue
basicType
outputFieldType (ComplexType (OptionalType FieldType
fieldType)) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [FieldType -> Text
outputFieldType FieldType
fieldType, Text
" | null | undefined"]
outputFieldType (ComplexType (ArrayType Integer
_size fieldType :: FieldType
fieldType@(ComplexType (OptionalType FieldType
_)))) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"(", FieldType -> Text
outputFieldType FieldType
fieldType, Text
")", Text
"[]"]
outputFieldType (ComplexType (ArrayType Integer
_size FieldType
fieldType)) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [FieldType -> Text
outputFieldType FieldType
fieldType, Text
"[]"]
outputFieldType (ComplexType (SliceType FieldType
fieldType)) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [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 appliedTypesOutput :: Text
appliedTypesOutput = [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
appliedTypesOutput, 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
"string"
outputBasicType BasicTypeValue
U8 = Text
"number"
outputBasicType BasicTypeValue
U16 = Text
"number"
outputBasicType BasicTypeValue
U32 = Text
"number"
outputBasicType BasicTypeValue
U64 = Text
"bigint"
outputBasicType BasicTypeValue
U128 = Text
"bigint"
outputBasicType BasicTypeValue
I8 = Text
"number"
outputBasicType BasicTypeValue
I16 = Text
"number"
outputBasicType BasicTypeValue
I32 = Text
"number"
outputBasicType BasicTypeValue
I64 = Text
"bigint"
outputBasicType BasicTypeValue
I128 = Text
"bigint"
outputBasicType BasicTypeValue
F32 = Text
"number"
outputBasicType BasicTypeValue
F64 = Text
"number"
outputBasicType BasicTypeValue
Boolean = Text
"boolean"

maybeJoinTypeVariables :: Maybe [TypeVariable] -> Text
maybeJoinTypeVariables :: Maybe [TypeVariable] -> Text
maybeJoinTypeVariables = Text -> ([TypeVariable] -> Text) -> Maybe [TypeVariable] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" [TypeVariable] -> Text
joinTypeVariables

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
">")