packages feed

gotyno-hs 1.0.2 → 1.1.0

raw patch · 20 files changed

+1413/−206 lines, 20 filesdep +aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson

API changes (from Hackage documentation)

- Parsing: AppState :: !IORef [Module] -> !IORef [Import] -> !IORef (Set ModuleName) -> !IORef [TypeDefinition] -> !IORef (Maybe DefinitionName) -> AppState
- Parsing: [$sel:currentDeclarationNamesReference:AppState] :: AppState -> !IORef (Set ModuleName)
- Parsing: [$sel:currentDefinitionNameReference:AppState] :: AppState -> !IORef (Maybe DefinitionName)
- Parsing: [$sel:currentDefinitionsReference:AppState] :: AppState -> !IORef [TypeDefinition]
- Parsing: [$sel:currentImportsReference:AppState] :: AppState -> !IORef [Import]
- Parsing: [$sel:modulesReference:AppState] :: AppState -> !IORef [Module]
- Parsing: addDeclarationName :: ModuleName -> Parser ()
- Parsing: addDefinition :: TypeDefinition -> Parser ()
- Parsing: addImports :: [Import] -> Parser ()
- Parsing: addModule :: Module -> IORef [Module] -> IO ()
- Parsing: arrayTypeP :: [TypeVariable] -> Parser ComplexTypeValue
- Parsing: basicStringP :: Parser BasicTypeValue
- Parsing: basicTypeValueP :: Parser BasicTypeValue
- Parsing: booleanP :: Parser BasicTypeValue
- Parsing: clearDeclarationNames :: Parser ()
- Parsing: clearDefinitions :: Parser ()
- Parsing: complexTypeP :: [TypeVariable] -> Parser ComplexTypeValue
- Parsing: constructorNameP :: Parser Text
- Parsing: constructorP :: [TypeVariable] -> Parser Constructor
- Parsing: constructorsP :: [TypeVariable] -> Parser [Constructor]
- Parsing: data AppState
- Parsing: declarationP :: Parser TypeDefinition
- Parsing: definitionNameP :: Parser DefinitionName
- Parsing: definitionReferenceP :: [TypeVariable] -> Parser DefinitionReference
- Parsing: embeddedConstructorNameP :: Parser Text
- Parsing: embeddedUnionP :: FieldName -> Parser TypeDefinition
- Parsing: embeddedUnionStructConstructorP :: [TypeVariable] -> Parser EmbeddedConstructor
- Parsing: embeddedUnionStructConstructorsP :: [TypeVariable] -> Parser [EmbeddedConstructor]
- Parsing: enumerationP :: Parser TypeDefinition
- Parsing: enumerationValueP :: Parser EnumerationValue
- Parsing: enumerationValuesP :: Parser [EnumerationValue]
- Parsing: falseP :: Parser Bool
- Parsing: fieldNameP :: Parser FieldName
- Parsing: fieldP :: [TypeVariable] -> Parser StructField
- Parsing: fieldTypeP :: [TypeVariable] -> Parser FieldType
- Parsing: fieldsP :: [TypeVariable] -> Parser [StructField]
- Parsing: floatP :: Parser BasicTypeValue
- Parsing: genericStructP :: DefinitionName -> [TypeVariable] -> Parser TypeDefinition
- Parsing: genericUnionP :: FieldName -> DefinitionName -> [TypeVariable] -> Parser TypeDefinition
- Parsing: getDeclarationNames :: Parser (Set ModuleName)
- Parsing: getDefinition :: DefinitionName -> Parser (Maybe TypeDefinition)
- Parsing: getDefinitions :: Parser [TypeDefinition]
- Parsing: getImport :: Text -> Parser (Maybe Import)
- Parsing: getImports :: Parser [Import]
- Parsing: getModule :: String -> Parser (Maybe Module)
- Parsing: hasDefinition :: TypeDefinition -> [TypeDefinition] -> Bool
- Parsing: importP :: Parser Import
- Parsing: importedReferenceP :: [TypeVariable] -> Parser DefinitionReference
- Parsing: intP :: Parser BasicTypeValue
- Parsing: integerSizes :: [Int]
- Parsing: integerTypeParsers :: Text -> [Parser Text]
- Parsing: literalBooleanP :: Parser LiteralTypeValue
- Parsing: literalFloatP :: Parser LiteralTypeValue
- Parsing: literalIntegerP :: Parser LiteralTypeValue
- Parsing: literalP :: Parser LiteralTypeValue
- Parsing: literalStringP :: Parser LiteralTypeValue
- Parsing: moduleP :: ModuleName -> FilePath -> Parser Module
- Parsing: optionalTypeP :: [TypeVariable] -> Parser ComplexTypeValue
- Parsing: partialFromLeft :: Either l r -> l
- Parsing: partialFromRight :: Either l r -> r
- Parsing: pascalWordP :: Parser Text
- Parsing: plainStructP :: DefinitionName -> Parser TypeDefinition
- Parsing: plainUnionP :: FieldName -> DefinitionName -> Parser TypeDefinition
- Parsing: pointerTypeP :: [TypeVariable] -> Parser ComplexTypeValue
- Parsing: precededBy :: Parser ignored -> Parser a -> Parser a
- Parsing: readCurrentDefinitionName :: Parser DefinitionName
- Parsing: recursiveReferenceP :: Parser DefinitionName
- Parsing: reportError :: String -> Parser a
- Parsing: run :: AppState -> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a)
- Parsing: setCurrentDefinitionName :: DefinitionName -> Parser ()
- Parsing: sliceTypeP :: [TypeVariable] -> Parser ComplexTypeValue
- Parsing: stringCharacterP :: Parser Char
- Parsing: structP :: Parser TypeDefinition
- Parsing: structReferenceP :: [TypeVariable] -> Parser DefinitionReference
- Parsing: tagTypeP :: Parser TagType
- Parsing: trueP :: Parser Bool
- Parsing: type Parser = ParsecT Void Text (RIO AppState)
- Parsing: typeDefinitionP :: Parser TypeDefinition
- Parsing: typeVariableReferenceP :: [TypeVariable] -> Parser TypeVariable
- Parsing: typeVariablesP :: Parser [Text]
- Parsing: uintP :: Parser BasicTypeValue
- Parsing: unionP :: FieldName -> Parser TypeDefinition
- Parsing: untaggedUnionCaseP :: Parser FieldType
- Parsing: untaggedUnionCasesP :: Parser [FieldType]
- Parsing: untaggedUnionP :: Parser TypeDefinition
+ Basic: Recruiter :: !String -> !String -> ![Maybe String] -> !Maybe Recruiter -> !Integer -> Recruiter
+ Basic: [$sel:recruiterCreated:Recruiter] :: Recruiter -> !Integer
+ Basic: [$sel:recruiterEmails:Recruiter] :: Recruiter -> ![Maybe String]
+ Basic: [$sel:recruiterName:Recruiter] :: Recruiter -> !String
+ Basic: [$sel:recruiterRecruiter:Recruiter] :: Recruiter -> !Maybe Recruiter
+ Basic: [$sel:recruiterType:Recruiter] :: Recruiter -> !String
+ Basic: data Recruiter
+ Basic: instance Data.Aeson.Types.FromJSON.FromJSON Basic.Recruiter
+ Basic: instance Data.Aeson.Types.ToJSON.ToJSON Basic.Recruiter
+ Basic: instance GHC.Classes.Eq Basic.Recruiter
+ Basic: instance GHC.Generics.Generic Basic.Recruiter
+ Basic: instance GHC.Show.Show Basic.Recruiter
+ CodeGeneration.Haskell: outputModule :: Module -> Text
+ CodeGeneration.Utilities: typeVariablesFrom :: FieldType -> Maybe [TypeVariable]
+ CodeGeneration.Utilities: typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable]
+ CodeGeneration.Utilities: typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable]
+ Gotyno.Helpers: LiteralString :: Text -> LiteralString
+ Gotyno.Helpers: StringEncodedInteger :: Integer -> StringEncodedInteger
+ Gotyno.Helpers: checkEqualTo :: (Eq a, Show a) => a -> a -> Parser a
+ Gotyno.Helpers: instance Data.Aeson.Types.FromJSON.FromJSON Gotyno.Helpers.StringEncodedInteger
+ Gotyno.Helpers: instance Data.Aeson.Types.ToJSON.ToJSON Gotyno.Helpers.LiteralString
+ Gotyno.Helpers: instance Data.Aeson.Types.ToJSON.ToJSON Gotyno.Helpers.StringEncodedInteger
+ Gotyno.Helpers: instance GHC.Classes.Eq Gotyno.Helpers.LiteralString
+ Gotyno.Helpers: instance GHC.Classes.Eq Gotyno.Helpers.StringEncodedInteger
+ Gotyno.Helpers: instance GHC.Show.Show Gotyno.Helpers.LiteralString
+ Gotyno.Helpers: instance GHC.Show.Show Gotyno.Helpers.StringEncodedInteger
+ Gotyno.Helpers: newtype LiteralString
+ Gotyno.Helpers: newtype StringEncodedInteger
+ Types: [$sel:unDefinitionName:DefinitionName] :: DefinitionName -> Text

Files

+ CHANGELOG.md view
@@ -0,0 +1,31 @@+# Changelog++## 1.1.0++### General++- Made the parser much less strict, allowing extra whitespace in many places.+  This is experimental for now, but should allow people to have just a bit more+  of their own style.++### Features++### Fixes++- Added checks for whether or not the user is applying enough/too many type+  parameters to the usage of a given definition/declaration. This was previously+  punted to the output language but if we are to output to languages with very+  poor static checks themselves, this safeguard is good to have.++## 1.0.2++### General++- Uploaded package to Stackage++### Features++### Fixes++- Clearing definitions & declarations on module parsing success *and* failure+- Using debouncing to handle duplicate file events when using `--watch`
gotyno-hs.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           gotyno-hs-version:        1.0.2+version:        1.1.0 synopsis:       A type definition compiler supporting multiple output languages. description:    Compiles type definitions into F#, TypeScript and Python, with validators, decoders and encoders. category:       Compiler@@ -15,6 +15,7 @@ build-type:     Simple extra-source-files:     README.md+    CHANGELOG.md     examples/basic.gotyno     examples/generics.gotyno     examples/github.gotyno@@ -39,15 +40,26 @@     test/reference-output/hasGeneric.py     test/reference-output/importExample.py     test/reference-output/python.py+    test/examples/applyingNonGeneric.gotyno     test/examples/declaration1.gotyno     test/examples/declaration2.gotyno+    test/examples/declaredGenerics1.gotyno+    test/examples/declaredGenerics2.gotyno+    test/examples/declaredGenerics3.gotyno+    test/examples/declaredGenerics4.gotyno+    test/examples/declaredGenerics5.gotyno+    test/examples/notApplyingEnoughGenericTypes.gotyno+    test/examples/relaxedWhiteSpace.gotyno  library   exposed-modules:+      Basic       CodeGeneration.FSharp+      CodeGeneration.Haskell       CodeGeneration.Python       CodeGeneration.TypeScript       CodeGeneration.Utilities+      Gotyno.Helpers       Library       Parsing       Types@@ -101,7 +113,8 @@       TypeApplications   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints   build-depends:-      base >=4.9.1.0 && <5+      aeson+    , base >=4.9.1.0 && <5     , fsnotify     , megaparsec     , pretty-show@@ -161,7 +174,8 @@       TypeApplications   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:-      base >=4.9.1.0 && <5+      aeson+    , base >=4.9.1.0 && <5     , fsnotify     , gotyno-hs     , megaparsec@@ -225,7 +239,8 @@       TypeApplications   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -Wall   build-depends:-      base >=4.9.1.0 && <5+      aeson+    , base >=4.9.1.0 && <5     , fsnotify     , gotyno-hs     , hspec >=2.0.0
+ src/Basic.hs view
@@ -0,0 +1,50 @@+module Basic where++import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))+import qualified Data.Aeson as JSON+import GHC.Generics (Generic)+import qualified Gotyno.Helpers as Helpers+import Prelude++data Recruiter = Recruiter+  { recruiterType :: !String,+    recruiterName :: !String,+    recruiterEmails :: ![Maybe String],+    recruiterRecruiter :: !(Maybe Recruiter),+    recruiterCreated :: !Integer+  }+  deriving (Eq, Show, Generic)++instance FromJSON Recruiter where+  parseJSON = JSON.withObject "Recruiter" $ \o -> do+    recruiterType <- o .: "type" >>= Helpers.checkEqualTo "Recruiter"+    recruiterName <- o .: "Name"+    recruiterEmails <- o .: "emails"+    recruiterRecruiter <- o .:? "recruiter"+    Helpers.StringEncodedInteger recruiterCreated <- o .: "created"+    pure $+      Recruiter+        { recruiterType,+          recruiterName,+          recruiterEmails,+          recruiterRecruiter,+          recruiterCreated+        }++instance ToJSON Recruiter where+  toJSON value =+    JSON.object+      [ "type" .= Helpers.LiteralString "Recruiter",+        "name" .= recruiterName value,+        "emails" .= recruiterEmails value,+        "recruiter" .= recruiterRecruiter value,+        "created" .= Helpers.StringEncodedInteger (recruiterCreated value)+      ]++-- struct Recruiter {+--     type: "Recruiter"+--     Name: String+--     emails: [3]?String+--     recruiter: ?*Recruiter+--     created: U64+-- }
src/CodeGeneration/FSharp.hs view
@@ -1,6 +1,6 @@ module CodeGeneration.FSharp (outputModule) where -import CodeGeneration.Utilities (upperCaseFirstCharacter)+import CodeGeneration.Utilities (typeVariablesFrom, upperCaseFirstCharacter) import RIO import qualified RIO.List.Partial as PartialList import qualified RIO.Text as Text@@ -710,57 +710,6 @@         [ mconcat ["type ", name, maybeTypeVariables, " =\n"],           cases         ]--typeVariablesFrom :: FieldType -> Maybe [TypeVariable]-typeVariablesFrom (TypeVariableReferenceType typeVariable) = pure [typeVariable]-typeVariablesFrom (ComplexType (ArrayType _size fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (ComplexType (SliceType fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (ComplexType (PointerType fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (ComplexType (OptionalType fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (RecursiveReferenceType _name) = Nothing-typeVariablesFrom (LiteralType _) = Nothing-typeVariablesFrom (BasicType _) = Nothing-typeVariablesFrom (DefinitionReferenceType definitionReference) =-  typeVariablesFromReference definitionReference--typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable]-typeVariablesFromReference (DefinitionReference definition) = typeVariablesFromDefinition definition-typeVariablesFromReference (ImportedDefinitionReference _moduleName definition) =-  typeVariablesFromDefinition definition-typeVariablesFromReference (AppliedGenericReference fieldTypes _definition) =-  let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join-   in if null typeVariables then Nothing else Just typeVariables-typeVariablesFromReference-  ( AppliedImportedGenericReference-      _moduleName-      (AppliedTypes fieldTypes)-      _definition-    ) =-    let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join-     in if null typeVariables then Nothing else Just typeVariables-typeVariablesFromReference-  ( GenericDeclarationReference-      _moduleName-      _definitionName-      (AppliedTypes fieldTypes)-    ) =-    let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join-     in if null typeVariables then Nothing else Just typeVariables-typeVariablesFromReference (DeclarationReference _moduleName _definitionName) =-  Nothing--typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable]-typeVariablesFromDefinition (TypeDefinition _name (Struct (PlainStruct _))) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (PlainUnion _))) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (UntaggedUnion _)) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (Enumeration _)) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (EmbeddedUnion _tagType _constructors)) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (Struct (GenericStruct typeVariables _))) =-  pure typeVariables-typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (GenericUnion typeVariables _))) =-  pure typeVariables-typeVariablesFromDefinition (TypeDefinition _name (DeclaredType _moduleName typeVariables)) =-  pure typeVariables  outputField :: Int -> StructField -> Text outputField indentation (StructField (FieldName name) fieldType) =
+ src/CodeGeneration/Haskell.hs view
@@ -0,0 +1,937 @@+module CodeGeneration.Haskell (outputModule) where++import CodeGeneration.Utilities (upperCaseFirstCharacter)+import RIO+import qualified RIO.List.Partial as PartialList+import qualified RIO.Text as Text+import Types++outputModule :: Module -> Text+outputModule Module {name = ModuleName name, definitions, imports, declarationNames} =+  let definitionOutput = definitions & mapMaybe outputDefinition & Text.intercalate "\n\n"+      importsOutput = imports & fmap outputImport & mconcat+      outputImport (Import Module {name = ModuleName importName}) =+        mconcat ["import qualified ", importName, " as ", importName, "\n\n"]+      declarationImportsOutput =+        declarationNames+          & fmap+            ( \(ModuleName declarationModuleName) ->+                mconcat+                  [ "import qualified ",+                    haskellifyModuleName declarationModuleName,+                    " as ",+                    haskellifyModuleName declarationModuleName+                  ]+            )+          & Text.intercalate "\n"+   in mconcat+        [ modulePrelude (haskellifyModuleName name),+          "\n\n",+          importsOutput,+          "\n\n",+          declarationImportsOutput,+          "\n\n",+          definitionOutput+        ]++haskellifyModuleName :: Text -> Text+haskellifyModuleName = upperCaseFirstCharacter++modulePrelude :: Text -> Text+modulePrelude name =+  mconcat+    [ mconcat ["module ", name, " where\n\n"],+      "import Data.Aeson (FromJSON(..), ToJSON(..))\n",+      "import qualified Data.Aeson as JSON\n",+      "import GHC.Generics (Generic)\n",+      "import qualified Gotyno.Helpers as Helpers\n",+      "import qualified Prelude"+    ]++outputDefinition :: TypeDefinition -> Maybe Text+outputDefinition (TypeDefinition (DefinitionName name) (Struct (PlainStruct fields))) =+  pure $ outputPlainStruct name fields+outputDefinition (TypeDefinition (DefinitionName name) (Struct (GenericStruct typeVariables fields))) =+  pure $ outputGenericStruct name typeVariables fields+outputDefinition (TypeDefinition (DefinitionName name) (Union typeTag unionType)) =+  pure $ outputUnion name typeTag unionType+outputDefinition (TypeDefinition (DefinitionName name) (Enumeration enumerationValues)) =+  pure $ outputEnumeration name enumerationValues+outputDefinition (TypeDefinition (DefinitionName name) (UntaggedUnion unionCases)) =+  pure $ outputUntaggedUnion name unionCases+outputDefinition (TypeDefinition (DefinitionName name) (EmbeddedUnion typeTag constructors)) =+  pure $ outputEmbeddedUnion name typeTag constructors+outputDefinition (TypeDefinition _name (DeclaredType _moduleName _typeVariables)) = Nothing++outputEmbeddedUnion :: Text -> FieldName -> [EmbeddedConstructor] -> Text+outputEmbeddedUnion unionName fieldName@(FieldName tag) constructors =+  let typeOutput =+        outputCaseUnion+          unionName+          constructorsAsConstructors+          []+      constructorsAsConstructors = embeddedConstructorsToConstructors constructors+      constructorDecodersOutput = outputEmbeddedConstructorDecoders unionName constructors+      tagDecoderPairsOutput =+        constructors+          & fmap+            ( \(EmbeddedConstructor (ConstructorName name) _reference) ->+                mconcat+                  [ "                \"",+                    name,+                    "\", ",+                    unionName,+                    ".",+                    upperCaseFirstCharacter name,+                    "Decoder\n"+                  ]+            )+          & mconcat+      decoderOutput =+        mconcat+          [ mconcat ["    static member Decoder: Decoder<", unionName, "> =\n"],+            "        GotynoCoders.decodeWithTypeTag\n",+            mconcat ["            \"", tag, "\"\n"],+            "            [|\n",+            tagDecoderPairsOutput,+            "            |]"+          ]+      constructorCasesOutput =+        constructors+          & fmap (outputEmbeddedCase fieldName)+          & Text.intercalate "\n\n"+      encoderOutput =+        mconcat+          [ mconcat ["    static member Encoder =\n"],+            "        function\n",+            constructorCasesOutput+          ]+   in Text.intercalate+        "\n\n"+        [ typeOutput,+          constructorDecodersOutput,+          decoderOutput,+          encoderOutput+        ]++outputEmbeddedCase :: FieldName -> EmbeddedConstructor -> Text+outputEmbeddedCase (FieldName tag) (EmbeddedConstructor (ConstructorName name) Nothing) =+  mconcat+    [ mconcat ["        | ", upperCaseFirstCharacter name, " payload ->\n"],+      "            Encode.object\n",+      "                [\n",+      mconcat ["                    \"", tag, "\", Encode.string \"", name, "\"\n"],+      "                ]"+    ]+outputEmbeddedCase (FieldName tag) (EmbeddedConstructor (ConstructorName name) (Just reference)) =+  let fields = structFieldsFromReference reference+      fieldsEncoderOutput =+        fields+          & fmap+            ( outputEncoderForFieldWithValueName "payload"+                >>> ("                    " <>)+                >>> (<> "\n")+            )+          & mconcat+   in mconcat+        [ mconcat ["        | ", upperCaseFirstCharacter name, " payload ->\n"],+          "            Encode.object\n",+          "                [\n",+          mconcat ["                    \"", tag, "\", Encode.string \"", name, "\"\n"],+          fieldsEncoderOutput,+          "                ]"+        ]++outputEmbeddedConstructorDecoders :: Text -> [EmbeddedConstructor] -> Text+outputEmbeddedConstructorDecoders unionName =+  fmap (outputEmbeddedConstructorDecoder unionName) >>> Text.intercalate "\n\n"++outputEmbeddedConstructorDecoder :: Text -> EmbeddedConstructor -> Text+outputEmbeddedConstructorDecoder unionName (EmbeddedConstructor (ConstructorName name) Nothing) =+  let constructorName = upperCaseFirstCharacter name+   in mconcat+        [ mconcat+            ["    static member ", constructorName, "Decoder: Decoder<", unionName, "> =\n"],+          mconcat ["        Decode.object (fun get -> ", constructorName, ")"]+        ]+outputEmbeddedConstructorDecoder+  unionName+  ( EmbeddedConstructor+      (ConstructorName name)+      (Just reference)+    ) =+    let structFields = structFieldsFromReference reference+        structFieldDecoders =+          structFields+            & fmap (outputDecoderForField >>> ("                " <>) >>> (<> "\n"))+            & mconcat+        constructorName = upperCaseFirstCharacter name+     in mconcat+          [ mconcat+              ["    static member ", constructorName, "Decoder: Decoder<", unionName, "> =\n"],+            "        Decode.object (fun get ->\n",+            mconcat ["            ", constructorName, " {\n"],+            structFieldDecoders,+            "            }\n",+            "        )"+          ]++structFieldsFromReference :: DefinitionReference -> [StructField]+structFieldsFromReference+  (DefinitionReference (TypeDefinition _name (Struct (PlainStruct fields)))) = fields+structFieldsFromReference _other = error "struct fields from anything other than plain struct"++embeddedConstructorsToConstructors :: [EmbeddedConstructor] -> [Constructor]+embeddedConstructorsToConstructors = fmap embeddedConstructorToConstructor++embeddedConstructorToConstructor :: EmbeddedConstructor -> Constructor+embeddedConstructorToConstructor (EmbeddedConstructor name reference) =+  Constructor name (DefinitionReferenceType <$> reference)++outputUntaggedUnion :: Text -> [FieldType] -> Text+outputUntaggedUnion unionName cases =+  let typeOutput = mconcat ["type ", unionName, " =\n", unionOutput]+      unionOutput = cases & fmap outputCaseLine & Text.intercalate "\n"+      outputCaseLine fieldType =+        mconcat+          [ "    | ",+            unionName,+            fieldTypeName fieldType,+            " of ",+            outputFieldType fieldType+          ]+      decoderOutput = outputUntaggedUnionDecoder unionName cases+      encoderOutput = outputUntaggedUnionEncoder unionName cases+   in Text.intercalate "\n\n" [typeOutput, decoderOutput, encoderOutput]++outputUntaggedUnionDecoder :: Text -> [FieldType] -> Text+outputUntaggedUnionDecoder name cases =+  let caseDecodersOutput = cases & fmap decoderForCase & Text.intercalate "\n\n"+      decoderForCase fieldType =+        let caseName = name <> fieldTypeName fieldType+         in mconcat+              [ mconcat ["    static member ", caseName, "Decoder: Decoder<", name, "> =\n"],+                mconcat ["        Decode.map ", caseName, " ", decoderForFieldType fieldType]+              ]+      oneOfListOutput =+        cases & fmap oneOfCaseOutput & mconcat+      oneOfCaseOutput caseFieldType =+        mconcat ["                ", name, ".", name, fieldTypeName caseFieldType, "Decoder\n"]+   in mconcat+        [ caseDecodersOutput,+          "\n\n",+          mconcat ["    static member Decoder: Decoder<", name, "> =\n"],+          mconcat ["        Decode.oneOf\n"],+          mconcat ["            [\n"],+          oneOfListOutput,+          mconcat ["            ]"]+        ]++outputUntaggedUnionEncoder :: Text -> [FieldType] -> Text+outputUntaggedUnionEncoder name cases =+  let caseEncodersOutput = cases & fmap encoderForCase & Text.intercalate "\n\n"+      encoderForCase caseFieldType =+        mconcat+          [ mconcat+              ["        | ", name, fieldTypeName caseFieldType, " payload ->\n"],+            mconcat+              ["            ", encoderForFieldType ("", "") caseFieldType, " payload"]+          ]+   in mconcat+        [ "    static member Encoder =\n",+          "        function\n",+          caseEncodersOutput+        ]++outputEnumeration :: Text -> [EnumerationValue] -> Text+outputEnumeration name values =+  let typeOutput = outputEnumerationType name values+      decoderOutput = outputEnumerationDecoder name values+      encoderOutput = outputEnumerationEncoder values+   in mconcat [typeOutput, "\n\n", decoderOutput, "\n\n", encoderOutput]++outputEnumerationType :: Text -> [EnumerationValue] -> Text+outputEnumerationType name values =+  let valuesOutput =+        values+          & fmap+            ( \(EnumerationValue (EnumerationIdentifier i) _literal) ->+                mconcat ["    | ", fsharpifyConstructorName i]+            )+          & Text.intercalate "\n"+   in mconcat [mconcat ["type ", name, " =\n"], valuesOutput]++fsharpifyConstructorName :: Text -> Text+fsharpifyConstructorName = upperCaseFirstCharacter++outputEnumerationDecoder :: Text -> [EnumerationValue] -> Text+outputEnumerationDecoder unionName values =+  let valuesOutput =+        values+          & fmap+            ( \(EnumerationValue (EnumerationIdentifier i) value) ->+                mconcat [outputLiteral value, ", ", fsharpifyConstructorName i]+            )+          & Text.intercalate "; "+      outputLiteral (LiteralString s) = "\"" <> s <> "\""+      outputLiteral (LiteralBoolean b) = bool "false" "true" b+      outputLiteral (LiteralInteger i) = tshow i+      outputLiteral (LiteralFloat f) = tshow f+      valuesDecoder =+        values+          & PartialList.head+          & ( \case+                (EnumerationValue _identifier (LiteralString _s)) ->+                  decoderForBasicType BasicString+                (EnumerationValue _identifier (LiteralBoolean _s)) ->+                  decoderForBasicType Boolean+                (EnumerationValue _identifier (LiteralInteger _s)) ->+                  decoderForBasicType I32+                (EnumerationValue _identifier (LiteralFloat _s)) ->+                  decoderForBasicType F32+            )+   in mconcat+        [ mconcat ["    static member Decoder: Decoder<", unionName, "> =\n"],+          mconcat ["        GotynoCoders.decodeOneOf ", valuesDecoder, " [|", valuesOutput, "|]"]+        ]++outputEnumerationEncoder :: [EnumerationValue] -> Text+outputEnumerationEncoder values =+  let caseOutput =+        values+          & fmap caseEncoder+          & Text.intercalate "\n"+      caseEncoder (EnumerationValue (EnumerationIdentifier i) (LiteralString s)) =+        mconcat ["        | ", fsharpifyConstructorName i, " -> Encode.string \"", s, "\""]+      caseEncoder (EnumerationValue (EnumerationIdentifier i) (LiteralBoolean b)) =+        let value = bool "false" "true" b+         in mconcat ["        | ", fsharpifyConstructorName i, " -> Encode.boolean ", value]+      caseEncoder (EnumerationValue (EnumerationIdentifier i) (LiteralInteger integer)) =+        mconcat ["        | ", fsharpifyConstructorName i, " -> Encode.int32 ", tshow integer]+      caseEncoder (EnumerationValue (EnumerationIdentifier i) (LiteralFloat f)) =+        mconcat ["        | ", fsharpifyConstructorName i, " -> Encode.float32 ", tshow f]+   in mconcat+        [ mconcat ["    static member Encoder =\n"],+          mconcat ["        function\n"],+          caseOutput+        ]++outputPlainStruct :: Text -> [StructField] -> Text+outputPlainStruct name fields =+  let fieldsOutput = fields & fmap (outputField 8) & mconcat+      decoderOutput = outputStructDecoder name fields []+      encoderOutput = outputStructEncoder fields []+   in mconcat+        [ mconcat ["type ", name, " =\n"],+          "    {\n",+          fieldsOutput,+          "    }\n\n",+          decoderOutput,+          "\n\n",+          encoderOutput+        ]++outputGenericStruct :: Text -> [TypeVariable] -> [StructField] -> Text+outputGenericStruct name typeVariables fields =+  let fullName = name <> joinTypeVariables typeVariables+      typeOutput =+        mconcat+          [ mconcat ["type ", fullName, " =\n"],+            "    {\n",+            fieldsOutput,+            "    }"+          ]+      fieldsOutput = fields & fmap (outputField 8) & mconcat+      decoderOutput = outputStructDecoder name fields typeVariables+      encoderOutput = outputStructEncoder fields typeVariables+   in mconcat [typeOutput, "\n\n", decoderOutput, "\n\n", encoderOutput]++outputStructDecoder :: Text -> [StructField] -> [TypeVariable] -> Text+outputStructDecoder name fields typeVariables =+  let prelude =+        mconcat ["    static member Decoder", maybeArguments, ": Decoder<", fullName, "> =\n"]+      fullName =+        if null typeVariables then name else mconcat [name, joinTypeVariables typeVariables]+      maybeArguments = typeVariableDecodersAsArguments typeVariables+      interface =+        fields & fmap (outputDecoderForField >>> addIndentation) & Text.intercalate "\n"+      addIndentation = ("                " <>)+   in mconcat+        [ mconcat+            [ prelude,+              "        Decode.object (fun get ->\n",+              "            {\n",+              mconcat [interface, "\n"],+              "            }\n",+              "        )"+            ]+        ]++outputStructEncoder :: [StructField] -> [TypeVariable] -> Text+outputStructEncoder fields typeVariables =+  let prelude =+        mconcat ["    static member Encoder", maybeArguments, " value =\n"]+      maybeArguments = typeVariableEncodersAsArguments typeVariables+      interface =+        fields & fmap (outputEncoderForField >>> addIndentation) & Text.intercalate "\n"+      addIndentation = ("                " <>)+   in mconcat+        [ mconcat+            [ prelude,+              "        Encode.object\n",+              "            [\n",+              mconcat [interface, "\n"],+              "            ]"+            ]+        ]++outputDecoderForField :: StructField -> Text+outputDecoderForField (StructField (FieldName fieldName) (ComplexType (OptionalType fieldType))) =+  mconcat+    [ upperCaseFirstCharacter fieldName,+      " = ",+      "get.Optional.Field",+      " \"",+      fieldName,+      "\" ",+      decoderForFieldType fieldType+    ]+outputDecoderForField (StructField (FieldName fieldName) fieldType) =+  mconcat+    [ upperCaseFirstCharacter fieldName,+      " = ",+      "get.Required.Field",+      " \"",+      fieldName,+      "\" ",+      decoderForFieldType fieldType+    ]++outputEncoderForField :: StructField -> Text+outputEncoderForField = outputEncoderForFieldWithValueName "value"++outputEncoderForFieldWithValueName :: Text -> StructField -> Text+outputEncoderForFieldWithValueName+  _valueName+  (StructField (FieldName fieldName) fieldType@(LiteralType _)) =+    mconcat ["\"", fieldName, "\", ", encoderForFieldType ("", "") fieldType]+outputEncoderForFieldWithValueName valueName (StructField (FieldName fieldName) fieldType) =+  mconcat+    [ "\"",+      fieldName,+      "\", ",+      encoderForFieldType ("", "") fieldType,+      " ",+      valueName,+      ".",+      upperCaseFirstCharacter fieldName+    ]++decoderForFieldType :: FieldType -> Text+decoderForFieldType (LiteralType literalType) = decoderForLiteralType literalType+decoderForFieldType (BasicType basicType) = decoderForBasicType basicType+decoderForFieldType (ComplexType complexType) = decoderForComplexType complexType+decoderForFieldType (DefinitionReferenceType definitionReference) =+  decoderForDefinitionReference definitionReference+decoderForFieldType (TypeVariableReferenceType (TypeVariable name)) = "decode" <> name+decoderForFieldType (RecursiveReferenceType (DefinitionName name)) = name <> ".Decoder"++decoderForBasicType :: BasicTypeValue -> Text+decoderForBasicType BasicString = "Decode.string"+decoderForBasicType U8 = "Decode.byte"+decoderForBasicType U16 = "Decode.uint16"+decoderForBasicType U32 = "Decode.uint32"+decoderForBasicType U64 = "Decode.uint64"+decoderForBasicType U128 = "Decode.uint128"+decoderForBasicType I8 = "Decode.int8"+decoderForBasicType I16 = "Decode.int16"+decoderForBasicType I32 = "Decode.int32"+decoderForBasicType I64 = "Decode.int64"+decoderForBasicType I128 = "Decode.int128"+decoderForBasicType F32 = "Decode.float32"+decoderForBasicType F64 = "Decode.float64"+decoderForBasicType Boolean = "Decode.bool"++decoderForLiteralType :: LiteralTypeValue -> Text+decoderForLiteralType (LiteralString s) = "(GotynoCoders.decodeLiteralString \"" <> s <> "\")"+decoderForLiteralType (LiteralInteger i) = "(GotynoCoders.decodeLiteralInteger " <> tshow i <> ")"+decoderForLiteralType (LiteralFloat f) = "(GotynoCoders.decodeLiteralFloat " <> tshow f <> ")"+decoderForLiteralType (LiteralBoolean b) =+  "(GotynoCoders.decodeLiteralBoolean " <> bool "false" "true" b <> ")"++decoderForComplexType :: ComplexTypeValue -> Text+decoderForComplexType (PointerType fieldType) = decoderForFieldType fieldType+decoderForComplexType (ArrayType _size fieldType) =+  mconcat ["(Decode.list ", decoderForFieldType fieldType, ")"]+decoderForComplexType (SliceType fieldType) =+  mconcat ["(Decode.list ", decoderForFieldType fieldType, ")"]+decoderForComplexType (OptionalType fieldType) =+  mconcat ["(Decode.option ", decoderForFieldType fieldType, ")"]++decoderForDefinitionReference :: DefinitionReference -> Text+decoderForDefinitionReference+  ( DefinitionReference+      (TypeDefinition (DefinitionName name) _typeData)+    ) =+    name <> ".Decoder"+decoderForDefinitionReference+  ( ImportedDefinitionReference+      (ModuleName moduleName)+      (TypeDefinition (DefinitionName name) _typeData)+    ) =+    mconcat [haskellifyModuleName moduleName, ".", name, ".Decoder"]+decoderForDefinitionReference+  ( AppliedGenericReference+      appliedTypes+      (TypeDefinition (DefinitionName name) _typeData)+    ) =+    let appliedDecoders = appliedTypes & fmap decoderForFieldType & Text.intercalate " "+     in mconcat ["(", name, ".Decoder ", appliedDecoders, ")"]+decoderForDefinitionReference+  ( AppliedImportedGenericReference+      (ModuleName moduleName)+      (AppliedTypes appliedTypes)+      (TypeDefinition (DefinitionName name) _typeData)+    ) =+    let appliedDecoders = appliedTypes & fmap decoderForFieldType & Text.intercalate " "+     in mconcat ["(", haskellifyModuleName moduleName, ".", name, ".Decoder ", appliedDecoders, ")"]+decoderForDefinitionReference+  ( GenericDeclarationReference+      (ModuleName moduleName)+      (DefinitionName name)+      (AppliedTypes appliedTypes)+    ) =+    let appliedDecoders = appliedTypes & fmap decoderForFieldType & Text.intercalate " "+     in mconcat ["(", haskellifyModuleName moduleName, ".", name, ".Decoder ", appliedDecoders, ")"]+decoderForDefinitionReference+  (DeclarationReference (ModuleName moduleName) (DefinitionName name)) =+    mconcat [haskellifyModuleName moduleName, ".", name, ".Decoder"]++encoderForFieldType :: (Text, Text) -> FieldType -> Text+encoderForFieldType (_l, _r) (LiteralType literalType) = encoderForLiteralType literalType+encoderForFieldType (_l, _r) (BasicType basicType) = encoderForBasicType basicType+encoderForFieldType (_l, _r) (ComplexType complexType@(PointerType _)) =+  encoderForComplexType complexType+encoderForFieldType (l, r) (ComplexType complexType) = l <> encoderForComplexType complexType <> r+encoderForFieldType (_l, _r) (DefinitionReferenceType definitionReference) =+  encoderForDefinitionReference definitionReference+encoderForFieldType (_l, _r) (TypeVariableReferenceType (TypeVariable name)) = "encode" <> name+encoderForFieldType (_l, _r) (RecursiveReferenceType (DefinitionName name)) = name <> ".Encoder"++encoderForBasicType :: BasicTypeValue -> Text+encoderForBasicType BasicString = "Encode.string"+encoderForBasicType U8 = "Encode.byte"+encoderForBasicType U16 = "Encode.uint16"+encoderForBasicType U32 = "Encode.uint32"+encoderForBasicType U64 = "Encode.uint64"+encoderForBasicType U128 = "Encode.uint128"+encoderForBasicType I8 = "Encode.int8"+encoderForBasicType I16 = "Encode.int16"+encoderForBasicType I32 = "Encode.int32"+encoderForBasicType I64 = "Encode.int64"+encoderForBasicType I128 = "Encode.int128"+encoderForBasicType F32 = "Encode.float32"+encoderForBasicType F64 = "Encode.float64"+encoderForBasicType Boolean = "Encode.bool"++encoderForLiteralType :: LiteralTypeValue -> Text+encoderForLiteralType (LiteralString s) = "Encode.string \"" <> s <> "\""+encoderForLiteralType (LiteralInteger i) = "Encode.int32 " <> tshow i+encoderForLiteralType (LiteralFloat f) = "Encode.float32 " <> tshow f+encoderForLiteralType (LiteralBoolean b) =+  "Encode.bool " <> bool "false" "true" b++encoderForComplexType :: ComplexTypeValue -> Text+encoderForComplexType (PointerType fieldType) = encoderForFieldType ("", "") fieldType+encoderForComplexType (ArrayType _size fieldType) =+  mconcat ["GotynoCoders.encodeList ", encoderForFieldType ("(", ")") fieldType]+encoderForComplexType (SliceType fieldType) =+  mconcat ["GotynoCoders.encodeList ", encoderForFieldType ("(", ")") fieldType]+encoderForComplexType (OptionalType fieldType) =+  mconcat ["Encode.option ", encoderForFieldType ("(", ")") fieldType, ""]++encoderForDefinitionReference :: DefinitionReference -> Text+encoderForDefinitionReference+  ( DefinitionReference+      (TypeDefinition (DefinitionName name) _typeData)+    ) =+    name <> ".Encoder"+encoderForDefinitionReference+  ( ImportedDefinitionReference+      (ModuleName moduleName)+      (TypeDefinition (DefinitionName name) _typeData)+    ) =+    mconcat [haskellifyModuleName moduleName, ".", name, ".Encoder"]+encoderForDefinitionReference+  ( AppliedGenericReference+      appliedTypes+      (TypeDefinition (DefinitionName name) _typeData)+    ) =+    let appliedEncoders = appliedTypes & fmap (encoderForFieldType ("", "")) & Text.intercalate " "+     in mconcat ["(", name, ".Encoder ", appliedEncoders, ")"]+encoderForDefinitionReference+  ( AppliedImportedGenericReference+      (ModuleName moduleName)+      (AppliedTypes appliedTypes)+      (TypeDefinition (DefinitionName name) _typeData)+    ) =+    let appliedEncoders = appliedTypes & fmap (encoderForFieldType ("", "")) & Text.intercalate " "+     in mconcat ["(", haskellifyModuleName moduleName, ".", name, ".Encoder ", appliedEncoders, ")"]+encoderForDefinitionReference+  ( GenericDeclarationReference+      (ModuleName moduleName)+      (DefinitionName name)+      (AppliedTypes appliedTypes)+    ) =+    let appliedEncoders = appliedTypes & fmap (encoderForFieldType ("", "")) & Text.intercalate " "+     in mconcat ["(", haskellifyModuleName moduleName, ".", name, ".Encoder ", appliedEncoders, ")"]+encoderForDefinitionReference+  (DeclarationReference (ModuleName moduleName) (DefinitionName name)) =+    mconcat [haskellifyModuleName moduleName, ".", name, ".Encoder"]++outputUnion :: Text -> FieldName -> UnionType -> Text+outputUnion name typeTag unionType =+  let caseUnionOutput = outputCaseUnion name (constructorsFrom unionType) typeVariables+      constructorsFrom (PlainUnion constructors) = constructors+      constructorsFrom (GenericUnion _typeVariables constructors) = constructors+      decoderOutput = outputUnionDecoder typeTag name (constructorsFrom unionType) typeVariables+      encoderOutput = outputUnionEncoder typeTag (constructorsFrom unionType) typeVariables+      typeVariables = case unionType of+        PlainUnion _constructors -> []+        GenericUnion ts _constructors -> ts+   in Text.intercalate+        "\n\n"+        [ caseUnionOutput,+          decoderOutput,+          encoderOutput+        ]++outputUnionDecoder :: FieldName -> Text -> [Constructor] -> [TypeVariable] -> Text+outputUnionDecoder (FieldName tag) unionName constructors typeVariables =+  let constructorDecodersOutput =+        constructors+          & fmap (outputConstructorDecoder unionName typeVariables)+          & Text.intercalate "\n\n"+      tagAndDecoderOutput =+        constructors+          & fmap+            ( \(Constructor (ConstructorName name) payload) ->+                let payloadTypeVariables = fromMaybe [] $ foldMap typeVariablesFrom payload+                    maybeDecoderArguments = typeVariableDecodersAsArguments payloadTypeVariables+                 in mconcat+                      [ "                \"",+                        name,+                        "\", ",+                        unionName,+                        ".",+                        upperCaseFirstCharacter name,+                        "Decoder",+                        maybeDecoderArguments,+                        "\n"+                      ]+            )+          & mconcat+      fullName =+        if null typeVariables+          then unionName+          else mconcat [unionName, joinTypeVariables typeVariables]+      maybeArguments = typeVariableDecodersAsArguments typeVariables+   in mconcat+        [ mconcat [constructorDecodersOutput, "\n\n"],+          mconcat ["    static member Decoder", maybeArguments, ": Decoder<", fullName, "> =\n"],+          mconcat ["        GotynoCoders.decodeWithTypeTag\n"],+          mconcat ["            \"", tag, "\"\n"],+          mconcat ["            [|\n"],+          tagAndDecoderOutput,+          mconcat ["            |]"]+        ]++typeVariableDecodersAsArguments :: [TypeVariable] -> Text+typeVariableDecodersAsArguments [] = ""+typeVariableDecodersAsArguments typeVariables =+  " " <> (decodersForTypeVariables typeVariables & Text.intercalate " ")++decodersForTypeVariables :: [TypeVariable] -> [Text]+decodersForTypeVariables = fmap (TypeVariableReferenceType >>> decoderForFieldType)++typeVariableEncodersAsArguments :: [TypeVariable] -> Text+typeVariableEncodersAsArguments [] = ""+typeVariableEncodersAsArguments typeVariables =+  " " <> (encodersForTypeVariables typeVariables & Text.intercalate " ")++encodersForTypeVariables :: [TypeVariable] -> [Text]+encodersForTypeVariables = fmap (TypeVariableReferenceType >>> encoderForFieldType ("", ""))++outputConstructorDecoder :: Text -> [TypeVariable] -> Constructor -> Text+outputConstructorDecoder unionName typeVariables (Constructor (ConstructorName name) maybePayload) =+  let decoder = maybe alwaysSucceedingDecoder decoderWithDataField maybePayload+      constructorName = upperCaseFirstCharacter name+      alwaysSucceedingDecoder = mconcat ["Decode.succeed ", constructorName]+      payloadTypeVariables = fromMaybe [] $ foldMap typeVariablesFrom maybePayload+      maybeArguments = typeVariableDecodersAsArguments payloadTypeVariables+      fullName =+        if null typeVariables+          then unionName+          else mconcat [unionName, joinTypeVariables typeVariables]+      decoderWithDataField payload =+        mconcat+          [ "Decode.object (fun get -> ",+            constructorName,+            "(get.Required.Field \"data\" ",+            decoderForFieldType payload,+            "))"+          ]+   in mconcat+        [ mconcat+            [ "    static member ",+              constructorName,+              "Decoder",+              maybeArguments,+              ": Decoder<",+              fullName,+              "> =\n"+            ],+          mconcat ["        ", decoder]+        ]++outputUnionEncoder :: FieldName -> [Constructor] -> [TypeVariable] -> Text+outputUnionEncoder typeTag constructors typeVariables =+  let caseEncodingOutput =+        constructors & fmap (outputConstructorEncoder typeTag) & Text.intercalate "\n\n"+      maybeArguments = typeVariableEncodersAsArguments typeVariables+   in mconcat+        [ mconcat ["    static member Encoder", maybeArguments, " =\n"],+          mconcat ["        function\n"],+          caseEncodingOutput+        ]++outputConstructorEncoder :: FieldName -> Constructor -> Text+outputConstructorEncoder (FieldName tag) (Constructor (ConstructorName name) maybePayload) =+  let dataPart = maybe "" encoderWithDataField maybePayload+      typeTagPart = mconcat ["\"", tag, "\", Encode.string \"", name, "\""]+      dataIndentation = "                            "+      encoderWithDataField payload =+        mconcat ["\n", dataIndentation, "\"data\", ", encoderForFieldType ("", "") payload, " payload"]+      interface = mconcat ["[ ", typeTagPart, dataPart, " ]"]+      maybePayloadPart = maybe "" (const " payload") maybePayload+   in mconcat+        [ mconcat ["        | ", upperCaseFirstCharacter name, maybePayloadPart, " ->\n"],+          mconcat ["            Encode.object ", interface]+        ]++outputCaseUnion :: Text -> [Constructor] -> [TypeVariable] -> Text+outputCaseUnion name constructors typeVariables =+  let cases =+        constructors+          & fmap+            ( \(Constructor (ConstructorName constructorName) maybePayload) ->+                let payload = maybe "" (outputFieldType >>> (" of " <>)) maybePayload+                 in mconcat ["    | ", upperCaseFirstCharacter constructorName, payload]+            )+          & Text.intercalate "\n"+      maybeTypeVariables = if null typeVariables then "" else joinTypeVariables typeVariables+   in mconcat+        [ mconcat ["type ", name, maybeTypeVariables, " =\n"],+          cases+        ]++typeVariablesFrom :: FieldType -> Maybe [TypeVariable]+typeVariablesFrom (TypeVariableReferenceType typeVariable) = pure [typeVariable]+typeVariablesFrom (ComplexType (ArrayType _size fieldType)) = typeVariablesFrom fieldType+typeVariablesFrom (ComplexType (SliceType fieldType)) = typeVariablesFrom fieldType+typeVariablesFrom (ComplexType (PointerType fieldType)) = typeVariablesFrom fieldType+typeVariablesFrom (ComplexType (OptionalType fieldType)) = typeVariablesFrom fieldType+typeVariablesFrom (RecursiveReferenceType _name) = Nothing+typeVariablesFrom (LiteralType _) = Nothing+typeVariablesFrom (BasicType _) = Nothing+typeVariablesFrom (DefinitionReferenceType definitionReference) =+  typeVariablesFromReference definitionReference++typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable]+typeVariablesFromReference (DefinitionReference definition) = typeVariablesFromDefinition definition+typeVariablesFromReference (ImportedDefinitionReference _moduleName definition) =+  typeVariablesFromDefinition definition+typeVariablesFromReference (AppliedGenericReference fieldTypes _definition) =+  let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join+   in if null typeVariables then Nothing else Just typeVariables+typeVariablesFromReference+  ( AppliedImportedGenericReference+      _moduleName+      (AppliedTypes fieldTypes)+      _definition+    ) =+    let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join+     in if null typeVariables then Nothing else Just typeVariables+typeVariablesFromReference+  ( GenericDeclarationReference+      _moduleName+      _definitionName+      (AppliedTypes fieldTypes)+    ) =+    let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join+     in if null typeVariables then Nothing else Just typeVariables+typeVariablesFromReference (DeclarationReference _moduleName _definitionName) =+  Nothing++typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable]+typeVariablesFromDefinition (TypeDefinition _name (Struct (PlainStruct _))) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (PlainUnion _))) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (UntaggedUnion _)) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (Enumeration _)) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (EmbeddedUnion _tagType _constructors)) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (Struct (GenericStruct typeVariables _))) =+  pure typeVariables+typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (GenericUnion typeVariables _))) =+  pure typeVariables+typeVariablesFromDefinition (TypeDefinition _name (DeclaredType _moduleName typeVariables)) =+  pure typeVariables++outputField :: Int -> StructField -> Text+outputField indentation (StructField (FieldName name) fieldType) =+  let indent = Text.pack $ replicate indentation ' '+   in indent <> mconcat [upperCaseFirstCharacter name, ": ", outputFieldType fieldType, "\n"]++outputFieldType :: FieldType -> Text+outputFieldType (LiteralType (LiteralString _text)) = outputBasicType BasicString+outputFieldType (LiteralType (LiteralInteger _x)) = outputBasicType I32+outputFieldType (LiteralType (LiteralFloat _f)) = outputBasicType F32+outputFieldType (LiteralType (LiteralBoolean _b)) = outputBasicType Boolean+outputFieldType (BasicType basicType) = outputBasicType basicType+outputFieldType (ComplexType (OptionalType fieldType)) =+  mconcat ["option<", outputFieldType fieldType, ">"]+outputFieldType (ComplexType (ArrayType _size fieldType)) =+  mconcat ["list<", outputFieldType fieldType, ">"]+outputFieldType (ComplexType (SliceType fieldType)) =+  mconcat ["list<", outputFieldType fieldType, ">"]+outputFieldType (ComplexType (PointerType fieldType)) = outputFieldType fieldType+outputFieldType (RecursiveReferenceType (DefinitionName name)) = name+outputFieldType (DefinitionReferenceType definitionReference) =+  outputDefinitionReference definitionReference+outputFieldType (TypeVariableReferenceType (TypeVariable t)) = fsharpifyTypeVariable t++fsharpifyTypeVariable :: Text -> Text+fsharpifyTypeVariable t = t & Text.toLower & ("'" <>)++outputDefinitionReference :: DefinitionReference -> Text+outputDefinitionReference (DefinitionReference (TypeDefinition (DefinitionName name) _)) = name+outputDefinitionReference+  ( ImportedDefinitionReference+      (ModuleName moduleName)+      (TypeDefinition (DefinitionName name) _typeData)+    ) =+    mconcat [haskellifyModuleName moduleName, ".", name]+outputDefinitionReference+  ( AppliedGenericReference+      appliedTypes+      (TypeDefinition (DefinitionName name) _)+    ) =+    let appliedFieldTypes = appliedTypes & fmap outputFieldType & Text.intercalate ", "+     in mconcat [name, "<", appliedFieldTypes, ">"]+outputDefinitionReference+  ( AppliedImportedGenericReference+      (ModuleName moduleName)+      (AppliedTypes appliedTypes)+      (TypeDefinition (DefinitionName name) _)+    ) =+    let appliedFieldTypes = appliedTypes & fmap outputFieldType & Text.intercalate ", "+     in mconcat [haskellifyModuleName moduleName, ".", name, "<", appliedFieldTypes, ">"]+outputDefinitionReference+  ( GenericDeclarationReference+      (ModuleName moduleName)+      (DefinitionName name)+      (AppliedTypes appliedTypes)+    ) =+    let appliedFieldTypes = appliedTypes & fmap outputFieldType & Text.intercalate ", "+        maybeAppliedOutput = if null appliedTypes then "" else mconcat ["<", appliedFieldTypes, ">"]+     in mconcat [haskellifyModuleName moduleName, ".", name, maybeAppliedOutput]+outputDefinitionReference (DeclarationReference (ModuleName moduleName) (DefinitionName name)) =+  mconcat [haskellifyModuleName moduleName, ".", name]++outputBasicType :: BasicTypeValue -> Text+outputBasicType BasicString = "string"+outputBasicType U8 = "uint8"+outputBasicType U16 = "uint16"+outputBasicType U32 = "uint32"+outputBasicType U64 = "uint64"+outputBasicType U128 = "uint128"+outputBasicType I8 = "int8"+outputBasicType I16 = "int16"+outputBasicType I32 = "int32"+outputBasicType I64 = "int64"+outputBasicType I128 = "int128"+outputBasicType F32 = "float32"+outputBasicType F64 = "float64"+outputBasicType Boolean = "bool"++fieldTypeName :: FieldType -> Text+fieldTypeName (LiteralType _) = error "Just don't use literals in untagged unions"+fieldTypeName (RecursiveReferenceType _) =+  error "Just don't use recursive references in untagged unions"+fieldTypeName (BasicType BasicString) = "String"+fieldTypeName (BasicType F32) = "F32"+fieldTypeName (BasicType F64) = "F64"+fieldTypeName (BasicType U8) = "U8"+fieldTypeName (BasicType U16) = "U16"+fieldTypeName (BasicType U32) = "U32"+fieldTypeName (BasicType U64) = "U64"+fieldTypeName (BasicType U128) = "U128"+fieldTypeName (BasicType I8) = "I8"+fieldTypeName (BasicType I16) = "I16"+fieldTypeName (BasicType I32) = "I32"+fieldTypeName (BasicType I64) = "I64"+fieldTypeName (BasicType I128) = "I128"+fieldTypeName (BasicType Boolean) = "Boolean"+fieldTypeName (TypeVariableReferenceType (TypeVariable t)) = t+fieldTypeName (ComplexType (ArrayType _ arrayFieldType)) =+  "ArrayOf" <> fieldTypeName arrayFieldType+fieldTypeName (ComplexType (SliceType sliceFieldType)) =+  "SliceOf" <> fieldTypeName sliceFieldType+fieldTypeName (ComplexType (PointerType pointerFieldType)) = fieldTypeName pointerFieldType+fieldTypeName (ComplexType (OptionalType optionalFieldType)) =+  "OptionalOf" <> fieldTypeName optionalFieldType+fieldTypeName+  ( DefinitionReferenceType+      (DefinitionReference (TypeDefinition (DefinitionName definitionName) _))+    ) =+    definitionName+fieldTypeName+  ( DefinitionReferenceType+      (ImportedDefinitionReference _ (TypeDefinition (DefinitionName definitionName) _))+    ) =+    definitionName+fieldTypeName+  ( DefinitionReferenceType+      ( AppliedGenericReference+          fieldTypes+          (TypeDefinition (DefinitionName definitionName) _)+        )+    ) =+    mconcat [definitionName, "Of", fieldTypes & fmap fieldTypeName & mconcat]+fieldTypeName+  ( DefinitionReferenceType+      ( AppliedImportedGenericReference+          _moduleName+          (AppliedTypes fieldTypes)+          (TypeDefinition (DefinitionName definitionName) _)+        )+    ) =+    mconcat [definitionName, "Of", fieldTypes & fmap fieldTypeName & mconcat]+fieldTypeName+  ( DefinitionReferenceType+      ( GenericDeclarationReference+          (ModuleName _moduleName)+          (DefinitionName definitionName)+          (AppliedTypes fieldTypes)+        )+    ) =+    mconcat [definitionName, "Of", fieldTypes & fmap fieldTypeName & mconcat]+fieldTypeName+  (DefinitionReferenceType (DeclarationReference _moduleName (DefinitionName definitionName))) =+    definitionName++joinTypeVariables :: [TypeVariable] -> Text+joinTypeVariables typeVariables =+  typeVariables+    & fmap (\(TypeVariable t) -> fsharpifyTypeVariable t)+    & Text.intercalate ", "+    & (\o -> "<" <> o <> ">")
src/CodeGeneration/Python.hs view
@@ -1,6 +1,6 @@ module CodeGeneration.Python (outputModule) where -import CodeGeneration.Utilities (upperCaseFirstCharacter)+import CodeGeneration.Utilities (typeVariablesFrom, upperCaseFirstCharacter) import RIO import qualified RIO.Text as Text import Types@@ -1058,57 +1058,6 @@  validatorsForTypeVariables :: [TypeVariable] -> [Text] validatorsForTypeVariables = fmap (TypeVariableReferenceType >>> validatorForFieldType)--typeVariablesFrom :: FieldType -> Maybe [TypeVariable]-typeVariablesFrom (TypeVariableReferenceType typeVariable) = pure [typeVariable]-typeVariablesFrom (ComplexType (ArrayType _size fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (ComplexType (SliceType fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (ComplexType (PointerType fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (ComplexType (OptionalType fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (RecursiveReferenceType _name) = Nothing-typeVariablesFrom (LiteralType _) = Nothing-typeVariablesFrom (BasicType _) = Nothing-typeVariablesFrom (DefinitionReferenceType definitionReference) =-  typeVariablesFromReference definitionReference--typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable]-typeVariablesFromReference (DefinitionReference definition) = typeVariablesFromDefinition definition-typeVariablesFromReference (ImportedDefinitionReference _moduleName definition) =-  typeVariablesFromDefinition definition-typeVariablesFromReference (AppliedGenericReference fieldTypes _definition) =-  let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join-   in if null typeVariables then Nothing else Just typeVariables-typeVariablesFromReference-  ( AppliedImportedGenericReference-      _moduleName-      (AppliedTypes fieldTypes)-      _definition-    ) =-    let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join-     in if null typeVariables then Nothing else Just typeVariables-typeVariablesFromReference-  ( GenericDeclarationReference-      _moduleName-      _definitionName-      (AppliedTypes fieldTypes)-    ) =-    let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join-     in if null typeVariables then Nothing else Just typeVariables-typeVariablesFromReference (DeclarationReference _moduleName _definitionName) =-  Nothing--typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable]-typeVariablesFromDefinition (TypeDefinition _name (Struct (PlainStruct _))) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (PlainUnion _))) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (UntaggedUnion _)) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (Enumeration _)) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (EmbeddedUnion _tagType _constructors)) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (Struct (GenericStruct typeVariables _))) =-  pure typeVariables-typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (GenericUnion typeVariables _))) =-  pure typeVariables-typeVariablesFromDefinition (TypeDefinition _name (DeclaredType _moduleName typeVariables)) =-  pure typeVariables  outputField :: Int -> StructField -> Text outputField indentation (StructField (FieldName name) fieldType) =
src/CodeGeneration/TypeScript.hs view
@@ -1,6 +1,6 @@ module CodeGeneration.TypeScript (outputModule) where -import CodeGeneration.Utilities (upperCaseFirstCharacter)+import CodeGeneration.Utilities (typeVariablesFrom, upperCaseFirstCharacter) import RIO import qualified RIO.Text as Text import Types@@ -1011,57 +1011,6 @@           & Text.intercalate " | "       maybeTypeVariables = if null typeVariables then "" else joinTypeVariables typeVariables    in mconcat ["export type ", name, maybeTypeVariables, " = ", cases, ";"]--typeVariablesFrom :: FieldType -> Maybe [TypeVariable]-typeVariablesFrom (TypeVariableReferenceType typeVariable) = pure [typeVariable]-typeVariablesFrom (ComplexType (ArrayType _size fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (ComplexType (SliceType fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (ComplexType (PointerType fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (ComplexType (OptionalType fieldType)) = typeVariablesFrom fieldType-typeVariablesFrom (RecursiveReferenceType _name) = Nothing-typeVariablesFrom (LiteralType _) = Nothing-typeVariablesFrom (BasicType _) = Nothing-typeVariablesFrom (DefinitionReferenceType definitionReference) =-  typeVariablesFromReference definitionReference--typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable]-typeVariablesFromReference (DefinitionReference definition) = typeVariablesFromDefinition definition-typeVariablesFromReference (ImportedDefinitionReference _moduleName definition) =-  typeVariablesFromDefinition definition-typeVariablesFromReference (AppliedGenericReference fieldTypes _definition) =-  let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join-   in if null typeVariables then Nothing else Just typeVariables-typeVariablesFromReference-  ( AppliedImportedGenericReference-      _moduleName-      (AppliedTypes fieldTypes)-      _definition-    ) =-    let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join-     in if null typeVariables then Nothing else Just typeVariables-typeVariablesFromReference-  ( GenericDeclarationReference-      _moduleName-      _definitionName-      (AppliedTypes appliedTypes)-    ) =-    let typeVariables = appliedTypes & fmap typeVariablesFrom & catMaybes & join-     in if null typeVariables then Nothing else Just typeVariables-typeVariablesFromReference (DeclarationReference _moduleName _definitionName) =-  Nothing--typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable]-typeVariablesFromDefinition (TypeDefinition _name (Struct (PlainStruct _))) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (PlainUnion _))) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (UntaggedUnion _)) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (Enumeration _)) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (EmbeddedUnion _tagType _constructors)) = Nothing-typeVariablesFromDefinition (TypeDefinition _name (Struct (GenericStruct typeVariables _))) =-  pure typeVariables-typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (GenericUnion typeVariables _))) =-  pure typeVariables-typeVariablesFromDefinition (TypeDefinition _name (DeclaredType _moduleName typeVariables)) =-  pure typeVariables  outputUnionTagEnumeration :: Text -> [Constructor] -> Text outputUnionTagEnumeration name constructors =
src/CodeGeneration/Utilities.hs view
@@ -3,9 +3,61 @@ import RIO import qualified RIO.Char as Char import qualified RIO.Text as Text+import Types  upperCaseFirstCharacter :: Text -> Text upperCaseFirstCharacter t =   case Text.uncons t of     Just (c, rest) -> Text.cons (Char.toUpper c) rest     Nothing -> t++typeVariablesFrom :: FieldType -> Maybe [TypeVariable]+typeVariablesFrom (TypeVariableReferenceType typeVariable) = pure [typeVariable]+typeVariablesFrom (ComplexType (ArrayType _size fieldType)) = typeVariablesFrom fieldType+typeVariablesFrom (ComplexType (SliceType fieldType)) = typeVariablesFrom fieldType+typeVariablesFrom (ComplexType (PointerType fieldType)) = typeVariablesFrom fieldType+typeVariablesFrom (ComplexType (OptionalType fieldType)) = typeVariablesFrom fieldType+typeVariablesFrom (RecursiveReferenceType _name) = Nothing+typeVariablesFrom (LiteralType _) = Nothing+typeVariablesFrom (BasicType _) = Nothing+typeVariablesFrom (DefinitionReferenceType definitionReference) =+  typeVariablesFromReference definitionReference++typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable]+typeVariablesFromDefinition (TypeDefinition _name (Struct (PlainStruct _))) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (PlainUnion _))) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (UntaggedUnion _)) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (Enumeration _)) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (EmbeddedUnion _tagType _constructors)) = Nothing+typeVariablesFromDefinition (TypeDefinition _name (Struct (GenericStruct typeVariables _))) =+  pure typeVariables+typeVariablesFromDefinition (TypeDefinition _name (Union _tagType (GenericUnion typeVariables _))) =+  pure typeVariables+typeVariablesFromDefinition (TypeDefinition _name (DeclaredType _moduleName typeVariables)) =+  pure typeVariables++typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable]+typeVariablesFromReference (DefinitionReference definition) = typeVariablesFromDefinition definition+typeVariablesFromReference (ImportedDefinitionReference _moduleName definition) =+  typeVariablesFromDefinition definition+typeVariablesFromReference (AppliedGenericReference fieldTypes _definition) =+  let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join+   in if null typeVariables then Nothing else Just typeVariables+typeVariablesFromReference+  ( AppliedImportedGenericReference+      _moduleName+      (AppliedTypes fieldTypes)+      _definition+    ) =+    let typeVariables = fieldTypes & fmap typeVariablesFrom & catMaybes & join+     in if null typeVariables then Nothing else Just typeVariables+typeVariablesFromReference+  ( GenericDeclarationReference+      _moduleName+      _definitionName+      (AppliedTypes appliedTypes)+    ) =+    let typeVariables = appliedTypes & fmap typeVariablesFrom & catMaybes & join+     in if null typeVariables then Nothing else Just typeVariables+typeVariablesFromReference (DeclarationReference _moduleName _definitionName) =+  Nothing
+ src/Gotyno/Helpers.hs view
@@ -0,0 +1,32 @@+module Gotyno.Helpers where++import Data.Aeson (FromJSON (..), ToJSON (..))+import qualified Data.Aeson as JSON+import Data.Aeson.Types (Parser)+import RIO+import qualified RIO.Text as Text++-- | Used for a more explicit style in `toJSON` instances. It also means we don't have to add type+-- annotations after the value.+newtype LiteralString = LiteralString Text+  deriving (Eq, Show, ToJSON)++-- | Used to encode `Integer` ({I,U}{64,128}) values, because there are ecosystems where these+-- cannot be decoded properly without having them come in as strings in transit.+newtype StringEncodedInteger = StringEncodedInteger Integer+  deriving (Eq, Show)++instance FromJSON StringEncodedInteger where+  parseJSON = JSON.withText "StringEncodedInteger" $ \text ->+    case text & Text.unpack & readMaybe of+      Just i -> pure $ StringEncodedInteger i+      Nothing -> fail $ mconcat ["Expected value readable as bigint, got: ", show text]++instance ToJSON StringEncodedInteger where+  toJSON (StringEncodedInteger i) = JSON.String $ tshow i++-- | Checks that a value matches an expectation, used to check literals.+checkEqualTo :: (Eq a, Show a) => a -> a -> Parser a+checkEqualTo expected actual+  | expected == actual = pure actual+  | otherwise = fail $ "Expected: " <> show expected <> " but got: " <> show actual
src/Parsing.hs view
@@ -1,5 +1,6 @@-module Parsing where+module Parsing (parseModules, test) where +import qualified CodeGeneration.Utilities as Utilities import RIO   ( Bool (..),     Char,@@ -23,6 +24,7 @@     for,     fromMaybe,     isLeft,+    length,     maybe,     mconcat,     mempty,@@ -40,6 +42,7 @@     (&),     (*>),     (.),+    (/=),     (<$),     (<$>),     (<*),@@ -55,7 +58,8 @@ import System.IO (putStrLn) import Text.Megaparsec import Text.Megaparsec.Char-import Text.Megaparsec.Char.Lexer+import Text.Megaparsec.Char.Lexer hiding (lexeme, symbol)+import qualified Text.Megaparsec.Char.Lexer as Lexer import Text.Show.Pretty (pPrint) import Types @@ -88,6 +92,8 @@     let moduleName = f & FilePath.takeBaseName & pack & ModuleName     fileContents <- readFileUtf8 f     maybeModule <- run state fileContents $ moduleP moduleName f+    writeIORef currentDefinitionsReference mempty+    writeIORef currentDeclarationNamesReference mempty     case maybeModule of       Right module' -> do         addModule module' modulesReference@@ -116,10 +122,8 @@ moduleP name sourceFile = do   imports <- fromMaybe [] <$> optional (sepEndBy1 importP newline <* newline)   addImports imports-  definitions <- sepBy1 typeDefinitionP (newline <* newline) <* eof+  definitions <- sepEndBy1 typeDefinitionP (some newline) <* eof   declarationNames <- Set.toList <$> getDeclarationNames-  clearDeclarationNames-  clearDefinitions   pure Module {name, imports, definitions, sourceFile, declarationNames}  addImports :: [Import] -> Parser ()@@ -137,14 +141,9 @@   AppState {currentDeclarationNamesReference} <- ask   readIORef currentDeclarationNamesReference -clearDeclarationNames :: Parser ()-clearDeclarationNames = do-  AppState {currentDeclarationNamesReference} <- ask-  writeIORef currentDeclarationNamesReference Set.empty- importP :: Parser Import importP = do-  string "import "+  symbol "import "   importName <- some (alphaNumChar <|> char '_')   maybeModule <- getModule importName   case maybeModule of@@ -168,23 +167,23 @@   keyword <- choice $ List.map string ["struct", "untagged union", "union", "enum", "declare"]   definition <- case keyword of     "struct" ->-      char ' ' *> structP+      some (char ' ') *> structP     "union" -> do       maybeTagType <- optional $ do-        _ <- char '('+        _ <- symbol "("         tagTypeP <* char ')'       let tagType = fromMaybe (StandardTypeTag $ FieldName "type") maybeTagType-      char ' ' *> case tagType of+      some (char ' ') *> case tagType of         StandardTypeTag fieldName ->           unionP fieldName         EmbeddedTypeTag fieldName ->           embeddedUnionP fieldName     "untagged union" ->-      char ' ' *> untaggedUnionP+      some (char ' ') *> untaggedUnionP     "enum" ->-      char ' ' *> enumerationP+      some (char ' ') *> enumerationP     "declare" ->-      char ' ' *> declarationP+      some (char ' ') *> declarationP     other ->       reportError $ "Unknown type definition keyword: " <> unpack other   addDefinition definition@@ -231,7 +230,7 @@  structP :: Parser TypeDefinition structP = do-  name <- readCurrentDefinitionName <* char ' '+  name <- lexeme readCurrentDefinitionName   maybeTypeVariables <- optional $ between (char '<') (char '>') typeVariablesP   string "{\n"   case maybeTypeVariables of@@ -251,17 +250,16 @@   pure $ TypeDefinition name $ Struct $ PlainStruct fields  constructorsP :: [TypeVariable] -> Parser [Constructor]-constructorsP = some . constructorP+constructorsP typeVariables = some $ some (char ' ') *> constructorP typeVariables  constructorP :: [TypeVariable] -> Parser Constructor constructorP typeVariables = do-  string "    "   name <- constructorNameP-  maybeColon <- optional $ string ": "+  maybeColon <- optional $ symbol ": "   payload <- case maybeColon of     Just _ -> Just <$> fieldTypeP typeVariables     Nothing -> pure Nothing-  newline+  many (char ' ') *> newline   pure $ Constructor (ConstructorName name) payload  constructorNameP :: Parser Text@@ -272,7 +270,7 @@  unionP :: FieldName -> Parser TypeDefinition unionP typeTag = do-  name <- readCurrentDefinitionName <* char ' '+  name <- lexeme readCurrentDefinitionName   maybeTypeVariables <- optional $ between (char '<') (char '>') typeVariablesP   string "{\n"   case maybeTypeVariables of@@ -281,7 +279,7 @@  embeddedUnionP :: FieldName -> Parser TypeDefinition embeddedUnionP typeTag = do-  name <- readCurrentDefinitionName <* string " {\n"+  name <- lexeme readCurrentDefinitionName <* string "{\n"   constructors <- embeddedUnionStructConstructorsP []   _ <- char '}'   pure $ TypeDefinition name (EmbeddedUnion typeTag constructors)@@ -300,11 +298,11 @@  embeddedUnionStructConstructorP :: [TypeVariable] -> Parser EmbeddedConstructor embeddedUnionStructConstructorP typeVariables = do-  constructorName <- string "    " *> embeddedConstructorNameP+  constructorName <- some (char ' ') *> embeddedConstructorNameP   maybeDefinition <-     choice-      [ Nothing <$ newline,-        Just <$> (string ": " *> structReferenceP typeVariables <* newline)+      [ Nothing <$ many (char ' ') <* newline,+        Just <$> (symbol ": " *> structReferenceP typeVariables <* many (char ' ') <* newline)       ]   pure $ EmbeddedConstructor (ConstructorName constructorName) maybeDefinition @@ -330,9 +328,7 @@  enumerationP :: Parser TypeDefinition enumerationP = do-  name <- definitionNameP-  setCurrentDefinitionName name-  string " {\n"+  name <- lexeme readCurrentDefinitionName <* "{\n"   values <- enumerationValuesP   char '}'   pure $ TypeDefinition name $ Enumeration values@@ -342,9 +338,9 @@  enumerationValueP :: Parser EnumerationValue enumerationValueP = do-  string "    "-  identifier <- (pack >>> EnumerationIdentifier) <$> someTill alphaNumChar (string " = ")-  value <- literalP <* newline+  some (char ' ')+  identifier <- (pack >>> EnumerationIdentifier) <$> someTill alphaNumChar (symbol " = ")+  value <- literalP <* many (char ' ') <* newline   pure $ EnumerationValue identifier value  plainUnionP :: FieldName -> DefinitionName -> Parser TypeDefinition@@ -366,9 +362,9 @@  fieldP :: [TypeVariable] -> Parser StructField fieldP typeVariables = do-  string "    "+  _ <- some $ char ' '   name <- fieldNameP-  string ": "+  symbol ": "   fieldType <- fieldTypeP typeVariables   newline   pure $ StructField name fieldType@@ -410,21 +406,65 @@   maybeDefinition <- getDefinition soughtName   maybeTypeVariables <-     optional $ between (char '<') (char '>') $ sepBy1 (fieldTypeP typeVariables) (string ", ")+  ensureMatchingGenericity maybeDefinition maybeTypeVariables   case maybeDefinition of-    Just (TypeDefinition name' (DeclaredType moduleName _typeVariables)) ->+    Just definition@(TypeDefinition name' (DeclaredType moduleName _typeVariables)) ->       case maybeTypeVariables of         Nothing ->           pure $ DeclarationReference moduleName name'         Just appliedTypes ->-          pure $ GenericDeclarationReference moduleName name' (AppliedTypes appliedTypes)+          if isGenericType definition+            then pure $ GenericDeclarationReference moduleName name' (AppliedTypes appliedTypes)+            else+              reportError $+                mconcat ["Trying to apply type as generic, but ", unpack n, " is not generic"]     Just definition -> do       case maybeTypeVariables of         Just appliedTypeVariables ->-          pure $ AppliedGenericReference appliedTypeVariables definition+          if isGenericType definition+            then pure $ AppliedGenericReference appliedTypeVariables definition+            else+              reportError $+                mconcat ["Trying to apply type as generic, but ", unpack n, " is not generic"]         Nothing ->           pure $ DefinitionReference definition     Nothing -> reportError $ mconcat ["Unknown type reference: ", unpack n] +ensureMatchingGenericity :: Maybe TypeDefinition -> Maybe [FieldType] -> Parser ()+ensureMatchingGenericity Nothing _maybeTypeParameters = pure ()+ensureMatchingGenericity (Just definition) maybeTypeParameters = do+  let expectedTypeParameters =+        definition+          & Utilities.typeVariablesFromDefinition+          & fromMaybe []+          & length+      name = definition & typeDefinitionName & unDefinitionName & unpack+      appliedTypeParameters = maybeTypeParameters & fromMaybe [] & length+  if expectedTypeParameters /= appliedTypeParameters+    then+      reportError $+        mconcat+          [ "Type ",+            name,+            " expects ",+            show expectedTypeParameters,+            " type parameters, ",+            show appliedTypeParameters,+            " applied"+          ]+    else pure ()++isGenericType :: TypeDefinition -> Bool+isGenericType (TypeDefinition _name (Struct (GenericStruct _typeVariables _fields))) = True+isGenericType (TypeDefinition _name (Union _tag (GenericUnion _typeVariables _constructors))) = True+isGenericType (TypeDefinition _name (Struct (PlainStruct _fields))) = False+isGenericType (TypeDefinition _name (Union _tag (PlainUnion _constructors))) = False+isGenericType (TypeDefinition _name (DeclaredType _moduleName typeVariables)) =+  not $ List.null typeVariables+isGenericType (TypeDefinition _name (EmbeddedUnion _tag _constructors)) = False+isGenericType (TypeDefinition _name (UntaggedUnion _cases)) = False+isGenericType (TypeDefinition _name (Enumeration _values)) = False+ getDefinitions :: Parser [TypeDefinition] getDefinitions = do   AppState {currentDefinitionsReference} <- ask@@ -445,11 +485,6 @@     then modifyIORef currentDefinitionsReference (definition :)     else reportError $ "Duplicate definition with name '" <> unpack definitionName <> "'" -clearDefinitions :: Parser ()-clearDefinitions = do-  AppState {currentDefinitionsReference} <- ask-  writeIORef currentDefinitionsReference mempty- hasDefinition :: TypeDefinition -> [TypeDefinition] -> Bool hasDefinition (TypeDefinition name _typeData) =   any (\(TypeDefinition name' _typeData) -> name == name')@@ -465,6 +500,7 @@       DefinitionReferenceType <$> importedReferenceP typeVariables,       RecursiveReferenceType <$> recursiveReferenceP     ]+    <* many (char ' ')  typeVariableReferenceP :: [TypeVariable] -> Parser TypeVariable typeVariableReferenceP typeVariables =@@ -620,3 +656,15 @@ partialFromLeft :: Either l r -> l partialFromLeft (Left l) = l partialFromLeft (Right _r) = error "Unable to get `Left` from `Right`"++typeDefinitionName :: TypeDefinition -> DefinitionName+typeDefinitionName (TypeDefinition name _) = name++lexeme :: Parser a -> Parser a+lexeme = Lexer.lexeme spaceConsumer++symbol :: Text -> Parser Text+symbol = Lexer.symbol spaceConsumer++spaceConsumer :: Parser ()+spaceConsumer = Lexer.space space1 (Lexer.skipLineComment "# ") empty
src/Types.hs view
@@ -17,7 +17,7 @@ newtype Import = Import Module   deriving (Eq, Show) -newtype DefinitionName = DefinitionName Text+newtype DefinitionName = DefinitionName {unDefinitionName :: Text}   deriving (Eq, Show)  data TypeDefinition = TypeDefinition !DefinitionName !TypeData
test/ParsingSpec.hs view
@@ -103,6 +103,135 @@               ["test/examples/declaration1.gotyno", "test/examples/declaration2.gotyno"]         length modules `shouldBe` 2 +    describe "Handles applied type parameters properly" $ do+      it "Errors out when trying to apply a non-generic type" $ do+        result <- parseModules ["test/examples/applyingNonGeneric.gotyno"]+        isLeft result `shouldBe` True+        case result of+          Left e ->+            PartialList.head e `shouldContain` "Type NotGeneric expects 0 type parameters"+          Right _ ->+            error "We should not hit `Right` when expecting error"++      it "Errors out when not applying enough type parameters" $ do+        result <- parseModules ["test/examples/notApplyingEnoughGenericTypes.gotyno"]+        isLeft result `shouldBe` True+        case result of+          Left e ->+            PartialList.head e+              `shouldContain` "Type GenericUnion expects 2 type parameters, 1 applied"+          Right _ ->+            error "We should not hit `Right` when expecting error"+      it "Handles one missing argument out of 2" $ do+        result <- parseModules ["test/examples/declaredGenerics1.gotyno"]+        isLeft result `shouldBe` True+        case result of+          Left e ->+            PartialList.head e+              `shouldContain` "Type GenericUnion expects 2 type parameters, 1 applied"+          Right _ ->+            error "We should not hit `Right` when expecting error"+      it "Handles two missing arguments out of 2" $ do+        result <- parseModules ["test/examples/declaredGenerics2.gotyno"]+        isLeft result `shouldBe` True+        case result of+          Left e ->+            PartialList.head e+              `shouldContain` "Type GenericUnion expects 2 type parameters, 0 applied"+          Right _ ->+            error "We should not hit `Right` when expecting error"+      it "Handles one missing arguments out of 1" $ do+        result <- parseModules ["test/examples/declaredGenerics3.gotyno"]+        isLeft result `shouldBe` True+        case result of+          Left e ->+            PartialList.head e+              `shouldContain` "Type GenericUnion expects 1 type parameters, 0 applied"+          Right _ ->+            error "We should not hit `Right` when expecting error"+      it "Errors out when trying to apply a non-generic declared type" $ do+        result <- parseModules ["test/examples/declaredGenerics5.gotyno"]+        isLeft result `shouldBe` True+        case result of+          Left e ->+            PartialList.head e+              `shouldContain` "Type GenericUnion expects 0 type parameters, 1 applied"+          Right _ ->+            error "We should not hit `Right` when expecting error"+      it "Gives correct result when all are applied" $ do+        result <- parseModules ["test/examples/declaredGenerics4.gotyno"]+        isRight result `shouldBe` True++    describe "Parser is less rigid about syntax than reference implementation" $ do+      it "Does not error out when extra whitespace is used in many places" $ do+        result <- parseModules ["test/examples/relaxedWhiteSpace.gotyno"]+        let expectedModule =+              Module+                { name = ModuleName "relaxedWhiteSpace",+                  imports = [],+                  declarationNames = [],+                  sourceFile = "test/examples/relaxedWhiteSpace.gotyno",+                  definitions = expectedDefinitions+                }+            expectedDefinitions =+              [ TypeDefinition+                  ( DefinitionName+                      "UsingExtraSpaces"+                  )+                  ( Struct+                      ( PlainStruct [StructField (FieldName "field") (BasicType BasicString)]+                      )+                  ),+                TypeDefinition+                  (DefinitionName "DefinitionWithoutManyNewlines")+                  (Struct (PlainStruct [StructField (FieldName "field2") (BasicType U32)])),+                TypeDefinition+                  (DefinitionName "SomeUnionName")+                  ( Union+                      (FieldName "type")+                      ( PlainUnion+                          [ Constructor (ConstructorName "One") (Just (BasicType U32)),+                            Constructor (ConstructorName "Two") Nothing+                          ]+                      )+                  ),+                TypeDefinition+                  (DefinitionName "Name")+                  ( EmbeddedUnion+                      (FieldName "kind")+                      [ EmbeddedConstructor (ConstructorName "NoPayload") Nothing,+                        EmbeddedConstructor+                          (ConstructorName "WithPayload")+                          ( Just+                              ( DefinitionReference+                                  ( TypeDefinition+                                      (DefinitionName "UsingExtraSpaces")+                                      ( Struct+                                          ( PlainStruct+                                              [ StructField+                                                  (FieldName "field")+                                                  (BasicType BasicString)+                                              ]+                                          )+                                      )+                                  )+                              )+                          )+                      ]+                  ),+                TypeDefinition+                  (DefinitionName "EnumName")+                  ( Enumeration+                      [ EnumerationValue+                          (EnumerationIdentifier "value1")+                          (LiteralString "value1"),+                        EnumerationValue (EnumerationIdentifier "value2") (LiteralString "value1")+                      ]+                  )+              ]+        result `shouldBe` Right [expectedModule]++    describe "Reference output" $ do       it "Gives the correct parsed output for `basic.gotyno`" $ do         Module {name, imports, definitions} <-           (getRight >>> PartialList.head) <$> parseModules ["examples/basic.gotyno"]@@ -166,6 +295,10 @@         let pythonPythonOutput = Python.outputModule pythonModule         pythonPythonOutput `shouldBe` pyPython -getRight :: (Show l) => Either l r -> r+getRight :: Either [String] r -> r getRight (Right r) = r-getRight (Left e) = error $ "unpacking `Left` in `fromRight`, error: " <> show e+getRight (Left e) = error $ mconcat e++shouldBeRight :: Either [String] r -> Expectation+shouldBeRight (Right _r) = pure ()+shouldBeRight (Left e) = error $ mconcat e
+ test/examples/applyingNonGeneric.gotyno view
@@ -0,0 +1,7 @@+struct NotGeneric {+    field: String+}++struct UsingNotGeneric {+    field: NotGeneric<String>+}
+ test/examples/declaredGenerics1.gotyno view
@@ -0,0 +1,5 @@+declare someModule.GenericUnion<T, U>++struct UsingGeneric {+    field: GenericUnion<String>+}
+ test/examples/declaredGenerics2.gotyno view
@@ -0,0 +1,5 @@+declare someModule.GenericUnion<T, U>++struct UsingGeneric {+    field: GenericUnion+}
+ test/examples/declaredGenerics3.gotyno view
@@ -0,0 +1,5 @@+declare someModule.GenericUnion<T>++struct UsingGeneric {+    field: GenericUnion+}
+ test/examples/declaredGenerics4.gotyno view
@@ -0,0 +1,5 @@+declare someModule.GenericUnion<T>++struct UsingGeneric {+    field: GenericUnion<String>+}
+ test/examples/declaredGenerics5.gotyno view
@@ -0,0 +1,5 @@+declare someModule.GenericUnion++struct UsingGeneric {+    field: GenericUnion<String>+}
+ test/examples/notApplyingEnoughGenericTypes.gotyno view
@@ -0,0 +1,8 @@+union GenericUnion <T, U>{+    One: T+    Two: U+}++struct UsingGeneric {+    field: GenericUnion<String>+}
+ test/examples/relaxedWhiteSpace.gotyno view
@@ -0,0 +1,22 @@+struct  UsingExtraSpaces  {+    field:  String  +}+struct DefinitionWithoutManyNewlines    {+   field2:      U32+}+++union   SomeUnionName   {+  One:    U32+    Two  +}++union(tag = kind, embedded)   Name   {+    NoPayload  + WithPayload:  UsingExtraSpaces    +}++enum  EnumName   {+ value1 =   "value1"    +     value2 = "value1"    +}