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 -> Text outputModule Module {$sel:name:Module :: Module -> ModuleName name = ModuleName Text name, [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 importName}) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "import qualified ", Text importName, Text " as ", Text importName, Text "\n\n"] declarationImportsOutput :: Text declarationImportsOutput = [ModuleName] declarationNames [ModuleName] -> ([ModuleName] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (ModuleName -> Text) -> [ModuleName] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ( \(ModuleName Text declarationModuleName) -> [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text "import qualified ", Text -> Text haskellifyModuleName Text declarationModuleName, Text " as ", Text -> Text haskellifyModuleName Text declarationModuleName ] ) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n" in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text -> Text modulePrelude (Text -> Text haskellifyModuleName Text name), Text "\n\n", Text importsOutput, Text "\n\n", Text declarationImportsOutput, Text "\n\n", Text definitionOutput ] haskellifyModuleName :: Text -> Text haskellifyModuleName :: Text -> Text haskellifyModuleName = Text -> Text upperCaseFirstCharacter modulePrelude :: Text -> Text modulePrelude :: Text -> Text modulePrelude Text name = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "module ", Text name, Text " where\n\n"], Text "import Data.Aeson (FromJSON(..), ToJSON(..))\n", Text "import qualified Data.Aeson as JSON\n", Text "import GHC.Generics (Generic)\n", Text "import qualified Gotyno.Helpers as Helpers\n", Text "import qualified Prelude" ] outputDefinition :: TypeDefinition -> Maybe Text outputDefinition :: TypeDefinition -> Maybe Text outputDefinition (TypeDefinition (DefinitionName Text name) (Struct (PlainStruct [StructField] fields))) = Text -> Maybe Text forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> Maybe Text) -> Text -> Maybe Text forall a b. (a -> b) -> a -> b $ Text -> [StructField] -> Text outputPlainStruct Text name [StructField] fields outputDefinition (TypeDefinition (DefinitionName Text name) (Struct (GenericStruct [TypeVariable] typeVariables [StructField] fields))) = Text -> Maybe Text forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> Maybe Text) -> Text -> Maybe Text forall a b. (a -> b) -> a -> b $ Text -> [TypeVariable] -> [StructField] -> Text outputGenericStruct Text name [TypeVariable] typeVariables [StructField] fields outputDefinition (TypeDefinition (DefinitionName Text name) (Union FieldName typeTag UnionType unionType)) = Text -> Maybe Text forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> Maybe Text) -> Text -> Maybe Text forall a b. (a -> b) -> a -> b $ Text -> FieldName -> UnionType -> Text outputUnion Text name FieldName typeTag UnionType unionType outputDefinition (TypeDefinition (DefinitionName Text name) (Enumeration [EnumerationValue] enumerationValues)) = Text -> Maybe Text forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> Maybe Text) -> Text -> Maybe Text forall a b. (a -> b) -> a -> b $ Text -> [EnumerationValue] -> Text outputEnumeration Text name [EnumerationValue] enumerationValues outputDefinition (TypeDefinition (DefinitionName Text name) (UntaggedUnion [FieldType] unionCases)) = Text -> Maybe Text forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> Maybe Text) -> Text -> Maybe Text forall a b. (a -> b) -> a -> b $ Text -> [FieldType] -> Text outputUntaggedUnion Text name [FieldType] unionCases outputDefinition (TypeDefinition (DefinitionName Text name) (EmbeddedUnion FieldName typeTag [EmbeddedConstructor] constructors)) = Text -> Maybe Text forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> Maybe Text) -> Text -> Maybe Text forall a b. (a -> b) -> a -> b $ Text -> FieldName -> [EmbeddedConstructor] -> Text outputEmbeddedUnion Text name FieldName typeTag [EmbeddedConstructor] constructors outputDefinition (TypeDefinition DefinitionName _name (DeclaredType ModuleName _moduleName [TypeVariable] _typeVariables)) = Maybe Text forall a. Maybe a Nothing outputEmbeddedUnion :: Text -> FieldName -> [EmbeddedConstructor] -> Text outputEmbeddedUnion :: Text -> FieldName -> [EmbeddedConstructor] -> Text outputEmbeddedUnion Text unionName fieldName :: FieldName fieldName@(FieldName Text tag) [EmbeddedConstructor] constructors = let typeOutput :: Text typeOutput = Text -> [Constructor] -> [TypeVariable] -> Text outputCaseUnion Text unionName [Constructor] constructorsAsConstructors [] constructorsAsConstructors :: [Constructor] constructorsAsConstructors = [EmbeddedConstructor] -> [Constructor] embeddedConstructorsToConstructors [EmbeddedConstructor] constructors constructorDecodersOutput :: Text constructorDecodersOutput = Text -> [EmbeddedConstructor] -> Text outputEmbeddedConstructorDecoders Text unionName [EmbeddedConstructor] constructors tagDecoderPairsOutput :: Text tagDecoderPairsOutput = [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 ( \(EmbeddedConstructor (ConstructorName Text name) Maybe DefinitionReference _reference) -> [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text " \"", Text name, Text "\", ", Text unionName, Text ".", Text -> Text upperCaseFirstCharacter Text name, Text "Decoder\n" ] ) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & [Text] -> Text forall a. Monoid a => [a] -> a mconcat decoderOutput :: Text decoderOutput = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member Decoder: Decoder<", Text unionName, Text "> =\n"], Text " GotynoCoders.decodeWithTypeTag\n", [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " \"", Text tag, Text "\"\n"], Text " [|\n", Text tagDecoderPairsOutput, Text " |]" ] constructorCasesOutput :: Text constructorCasesOutput = [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 (FieldName -> EmbeddedConstructor -> Text outputEmbeddedCase FieldName fieldName) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n\n" encoderOutput :: Text encoderOutput = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member Encoder =\n"], Text " function\n", Text constructorCasesOutput ] in Text -> [Text] -> Text Text.intercalate Text "\n\n" [ Text typeOutput, Text constructorDecodersOutput, Text decoderOutput, Text encoderOutput ] outputEmbeddedCase :: FieldName -> EmbeddedConstructor -> Text outputEmbeddedCase :: FieldName -> EmbeddedConstructor -> Text outputEmbeddedCase (FieldName Text tag) (EmbeddedConstructor (ConstructorName Text name) Maybe DefinitionReference Nothing) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " | ", Text -> Text upperCaseFirstCharacter Text name, Text " payload ->\n"], Text " Encode.object\n", Text " [\n", [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " \"", Text tag, Text "\", Encode.string \"", Text name, Text "\"\n"], Text " ]" ] outputEmbeddedCase (FieldName Text tag) (EmbeddedConstructor (ConstructorName Text name) (Just DefinitionReference reference)) = let fields :: [StructField] fields = DefinitionReference -> [StructField] structFieldsFromReference DefinitionReference reference fieldsEncoderOutput :: Text fieldsEncoderOutput = [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 ( Text -> StructField -> Text outputEncoderForFieldWithValueName Text "payload" (StructField -> Text) -> (Text -> Text) -> StructField -> 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 forall a. Semigroup a => a -> a -> a <>) (Text -> Text) -> (Text -> Text) -> Text -> Text forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\n") ) [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 " | ", Text -> Text upperCaseFirstCharacter Text name, Text " payload ->\n"], Text " Encode.object\n", Text " [\n", [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " \"", Text tag, Text "\", Encode.string \"", Text name, Text "\"\n"], Text fieldsEncoderOutput, Text " ]" ] outputEmbeddedConstructorDecoders :: Text -> [EmbeddedConstructor] -> Text outputEmbeddedConstructorDecoders :: Text -> [EmbeddedConstructor] -> Text outputEmbeddedConstructorDecoders Text unionName = (EmbeddedConstructor -> Text) -> [EmbeddedConstructor] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -> EmbeddedConstructor -> Text outputEmbeddedConstructorDecoder 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" outputEmbeddedConstructorDecoder :: Text -> EmbeddedConstructor -> Text outputEmbeddedConstructorDecoder :: Text -> EmbeddedConstructor -> Text outputEmbeddedConstructorDecoder Text unionName (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 " static member ", Text constructorName, Text "Decoder: Decoder<", Text unionName, Text "> =\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " Decode.object (fun get -> ", Text constructorName, Text ")"] ] outputEmbeddedConstructorDecoder Text unionName ( EmbeddedConstructor (ConstructorName Text name) (Just DefinitionReference reference) ) = let structFields :: [StructField] structFields = DefinitionReference -> [StructField] structFieldsFromReference DefinitionReference reference structFieldDecoders :: Text structFieldDecoders = [StructField] structFields [StructField] -> ([StructField] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (StructField -> Text) -> [StructField] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (StructField -> Text outputDecoderForField (StructField -> Text) -> (Text -> Text) -> StructField -> 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 forall a. Semigroup a => a -> a -> a <>) (Text -> Text) -> (Text -> Text) -> Text -> Text forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\n")) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & [Text] -> Text forall a. Monoid a => [a] -> a mconcat 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 " static member ", Text constructorName, Text "Decoder: Decoder<", Text unionName, Text "> =\n"], Text " Decode.object (fun get ->\n", [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " ", Text constructorName, Text " {\n"], Text structFieldDecoders, Text " }\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 "type ", Text unionName, Text " =\n", Text unionOutput] 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 outputCaseLine [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n" outputCaseLine :: FieldType -> Text outputCaseLine FieldType fieldType = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text " | ", Text unionName, FieldType -> Text fieldTypeName FieldType fieldType, Text " of ", FieldType -> Text outputFieldType FieldType fieldType ] decoderOutput :: Text decoderOutput = Text -> [FieldType] -> Text outputUntaggedUnionDecoder Text unionName [FieldType] cases encoderOutput :: Text encoderOutput = Text -> [FieldType] -> Text outputUntaggedUnionEncoder Text unionName [FieldType] cases in Text -> [Text] -> Text Text.intercalate Text "\n\n" [Text typeOutput, Text decoderOutput, Text encoderOutput] outputUntaggedUnionDecoder :: Text -> [FieldType] -> Text outputUntaggedUnionDecoder :: Text -> [FieldType] -> Text outputUntaggedUnionDecoder Text name [FieldType] cases = let caseDecodersOutput :: Text caseDecodersOutput = [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 decoderForCase [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n\n" decoderForCase :: FieldType -> Text decoderForCase FieldType fieldType = let caseName :: Text caseName = Text name Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> FieldType -> Text fieldTypeName FieldType fieldType in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member ", Text caseName, Text "Decoder: Decoder<", Text name, Text "> =\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " Decode.map ", Text caseName, Text " ", FieldType -> Text decoderForFieldType FieldType fieldType] ] oneOfListOutput :: Text oneOfListOutput = [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 oneOfCaseOutput [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & [Text] -> Text forall a. Monoid a => [a] -> a mconcat oneOfCaseOutput :: FieldType -> Text oneOfCaseOutput FieldType caseFieldType = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " ", Text name, Text ".", Text name, FieldType -> Text fieldTypeName FieldType caseFieldType, Text "Decoder\n"] in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text caseDecodersOutput, Text "\n\n", [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member Decoder: Decoder<", Text name, Text "> =\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " Decode.oneOf\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " [\n"], Text oneOfListOutput, [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " ]"] ] outputUntaggedUnionEncoder :: Text -> [FieldType] -> Text outputUntaggedUnionEncoder :: Text -> [FieldType] -> Text outputUntaggedUnionEncoder Text name [FieldType] cases = let caseEncodersOutput :: Text caseEncodersOutput = [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 encoderForCase [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n\n" encoderForCase :: FieldType -> Text encoderForCase FieldType caseFieldType = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " | ", Text name, FieldType -> Text fieldTypeName FieldType caseFieldType, Text " payload ->\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " ", (Text, Text) -> FieldType -> Text encoderForFieldType (Text "", Text "") FieldType caseFieldType, Text " payload"] ] in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text " static member Encoder =\n", Text " function\n", Text caseEncodersOutput ] 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 decoderOutput :: Text decoderOutput = Text -> [EnumerationValue] -> Text outputEnumerationDecoder Text name [EnumerationValue] values encoderOutput :: Text encoderOutput = [EnumerationValue] -> Text outputEnumerationEncoder [EnumerationValue] values in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text typeOutput, Text "\n\n", Text decoderOutput, Text "\n\n", Text encoderOutput] outputEnumerationType :: Text -> [EnumerationValue] -> Text outputEnumerationType :: Text -> [EnumerationValue] -> Text outputEnumerationType Text name [EnumerationValue] values = let valuesOutput :: Text valuesOutput = [EnumerationValue] values [EnumerationValue] -> ([EnumerationValue] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (EnumerationValue -> Text) -> [EnumerationValue] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ( \(EnumerationValue (EnumerationIdentifier Text i) LiteralTypeValue _literal) -> [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " | ", Text -> Text fsharpifyConstructorName Text i] ) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n" in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [[Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "type ", Text name, Text " =\n"], Text valuesOutput] fsharpifyConstructorName :: Text -> Text fsharpifyConstructorName :: Text -> Text fsharpifyConstructorName = Text -> Text upperCaseFirstCharacter outputEnumerationDecoder :: Text -> [EnumerationValue] -> Text outputEnumerationDecoder :: Text -> [EnumerationValue] -> Text outputEnumerationDecoder Text unionName [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] -> Text forall a. Monoid a => [a] -> a mconcat [LiteralTypeValue -> Text outputLiteral LiteralTypeValue value, Text ", ", Text -> Text fsharpifyConstructorName Text i] ) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "; " outputLiteral :: LiteralTypeValue -> Text outputLiteral (LiteralString Text s) = Text "\"" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text s Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\"" outputLiteral (LiteralBoolean Bool b) = Text -> Text -> Bool -> Text forall a. a -> a -> Bool -> a bool Text "false" Text "true" Bool b 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 valuesDecoder :: Text valuesDecoder = [EnumerationValue] values [EnumerationValue] -> ([EnumerationValue] -> EnumerationValue) -> EnumerationValue forall a b. a -> (a -> b) -> b & [EnumerationValue] -> EnumerationValue forall a. [a] -> a PartialList.head EnumerationValue -> (EnumerationValue -> Text) -> Text forall a b. a -> (a -> b) -> b & ( \case (EnumerationValue EnumerationIdentifier _identifier (LiteralString Text _s)) -> BasicTypeValue -> Text decoderForBasicType BasicTypeValue BasicString (EnumerationValue EnumerationIdentifier _identifier (LiteralBoolean Bool _s)) -> BasicTypeValue -> Text decoderForBasicType BasicTypeValue Boolean (EnumerationValue EnumerationIdentifier _identifier (LiteralInteger Integer _s)) -> BasicTypeValue -> Text decoderForBasicType BasicTypeValue I32 (EnumerationValue EnumerationIdentifier _identifier (LiteralFloat Float _s)) -> BasicTypeValue -> Text decoderForBasicType BasicTypeValue F32 ) in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member Decoder: Decoder<", Text unionName, Text "> =\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " GotynoCoders.decodeOneOf ", Text valuesDecoder, Text " [|", Text valuesOutput, Text "|]"] ] outputEnumerationEncoder :: [EnumerationValue] -> Text outputEnumerationEncoder :: [EnumerationValue] -> Text outputEnumerationEncoder [EnumerationValue] values = let caseOutput :: Text caseOutput = [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 -> Text caseEncoder [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n" caseEncoder :: EnumerationValue -> Text caseEncoder (EnumerationValue (EnumerationIdentifier Text i) (LiteralString Text s)) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " | ", Text -> Text fsharpifyConstructorName Text i, Text " -> Encode.string \"", Text s, Text "\""] caseEncoder (EnumerationValue (EnumerationIdentifier Text i) (LiteralBoolean Bool b)) = let value :: Text value = 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 -> Text fsharpifyConstructorName Text i, Text " -> Encode.boolean ", Text value] caseEncoder (EnumerationValue (EnumerationIdentifier Text i) (LiteralInteger Integer integer)) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " | ", Text -> Text fsharpifyConstructorName Text i, Text " -> Encode.int32 ", Integer -> Text forall a. Show a => a -> Text tshow Integer integer] caseEncoder (EnumerationValue (EnumerationIdentifier Text i) (LiteralFloat Float f)) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " | ", Text -> Text fsharpifyConstructorName Text i, Text " -> Encode.float32 ", Float -> Text forall a. Show a => a -> Text tshow Float f] in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member Encoder =\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " function\n"], Text caseOutput ] outputPlainStruct :: Text -> [StructField] -> Text outputPlainStruct :: Text -> [StructField] -> Text outputPlainStruct Text name [StructField] fields = let fieldsOutput :: Text fieldsOutput = [StructField] fields [StructField] -> ([StructField] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (StructField -> Text) -> [StructField] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Int -> StructField -> Text outputField Int 8) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & [Text] -> Text forall a. Monoid a => [a] -> a mconcat decoderOutput :: Text decoderOutput = Text -> [StructField] -> [TypeVariable] -> Text outputStructDecoder Text name [StructField] fields [] encoderOutput :: Text encoderOutput = [StructField] -> [TypeVariable] -> Text outputStructEncoder [StructField] fields [] in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "type ", Text name, Text " =\n"], Text " {\n", Text fieldsOutput, Text " }\n\n", Text decoderOutput, Text "\n\n", Text encoderOutput ] outputGenericStruct :: Text -> [TypeVariable] -> [StructField] -> Text outputGenericStruct :: Text -> [TypeVariable] -> [StructField] -> Text outputGenericStruct Text name [TypeVariable] typeVariables [StructField] fields = let fullName :: Text fullName = Text 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 "type ", Text fullName, Text " =\n"], 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 (Int -> StructField -> Text outputField Int 8) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & [Text] -> Text forall a. Monoid a => [a] -> a mconcat decoderOutput :: Text decoderOutput = Text -> [StructField] -> [TypeVariable] -> Text outputStructDecoder Text name [StructField] fields [TypeVariable] typeVariables encoderOutput :: Text encoderOutput = [StructField] -> [TypeVariable] -> Text outputStructEncoder [StructField] fields [TypeVariable] typeVariables in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text typeOutput, Text "\n\n", Text decoderOutput, Text "\n\n", Text encoderOutput] outputStructDecoder :: Text -> [StructField] -> [TypeVariable] -> Text outputStructDecoder :: Text -> [StructField] -> [TypeVariable] -> Text outputStructDecoder Text name [StructField] fields [TypeVariable] typeVariables = let prelude :: Text prelude = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member Decoder", Text maybeArguments, Text ": Decoder<", Text fullName, Text "> =\n"] fullName :: Text fullName = if [TypeVariable] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [TypeVariable] typeVariables then Text name else [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text name, [TypeVariable] -> Text joinTypeVariables [TypeVariable] typeVariables] maybeArguments :: Text maybeArguments = [TypeVariable] -> Text typeVariableDecodersAsArguments [TypeVariable] typeVariables interface :: Text interface = [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 outputDecoderForField (StructField -> Text) -> (Text -> Text) -> StructField -> 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 addIndentation) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n" addIndentation :: Text -> Text addIndentation = (Text " " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <>) in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text prelude, Text " Decode.object (fun get ->\n", Text " {\n", [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text interface, Text "\n"], Text " }\n", Text " )" ] ] outputStructEncoder :: [StructField] -> [TypeVariable] -> Text outputStructEncoder :: [StructField] -> [TypeVariable] -> Text outputStructEncoder [StructField] fields [TypeVariable] typeVariables = let prelude :: Text prelude = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member Encoder", Text maybeArguments, Text " value =\n"] maybeArguments :: Text maybeArguments = [TypeVariable] -> Text typeVariableEncodersAsArguments [TypeVariable] typeVariables interface :: Text interface = [StructField] fields [StructField] -> ([StructField] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (StructField -> Text) -> [StructField] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (StructField -> Text outputEncoderForField (StructField -> Text) -> (Text -> Text) -> StructField -> 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 addIndentation) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n" addIndentation :: Text -> Text addIndentation = (Text " " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <>) in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text prelude, Text " Encode.object\n", Text " [\n", [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text interface, Text "\n"], Text " ]" ] ] outputDecoderForField :: StructField -> Text outputDecoderForField :: StructField -> Text outputDecoderForField (StructField (FieldName Text fieldName) (ComplexType (OptionalType FieldType fieldType))) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text -> Text upperCaseFirstCharacter Text fieldName, Text " = ", Text "get.Optional.Field", Text " \"", Text fieldName, Text "\" ", FieldType -> Text decoderForFieldType FieldType fieldType ] outputDecoderForField (StructField (FieldName Text fieldName) FieldType fieldType) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text -> Text upperCaseFirstCharacter Text fieldName, Text " = ", Text "get.Required.Field", Text " \"", Text fieldName, Text "\" ", FieldType -> Text decoderForFieldType FieldType fieldType ] outputEncoderForField :: StructField -> Text outputEncoderForField :: StructField -> Text outputEncoderForField = Text -> StructField -> Text outputEncoderForFieldWithValueName Text "value" outputEncoderForFieldWithValueName :: Text -> StructField -> Text outputEncoderForFieldWithValueName :: Text -> StructField -> Text outputEncoderForFieldWithValueName Text _valueName (StructField (FieldName Text fieldName) fieldType :: FieldType fieldType@(LiteralType LiteralTypeValue _)) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "\"", Text fieldName, Text "\", ", (Text, Text) -> FieldType -> Text encoderForFieldType (Text "", Text "") FieldType fieldType] outputEncoderForFieldWithValueName Text valueName (StructField (FieldName Text fieldName) FieldType fieldType) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text "\"", Text fieldName, Text "\", ", (Text, Text) -> FieldType -> Text encoderForFieldType (Text "", Text "") FieldType fieldType, Text " ", Text valueName, Text ".", Text -> Text upperCaseFirstCharacter Text fieldName ] decoderForFieldType :: FieldType -> Text decoderForFieldType :: FieldType -> Text decoderForFieldType (LiteralType LiteralTypeValue literalType) = LiteralTypeValue -> Text decoderForLiteralType LiteralTypeValue literalType decoderForFieldType (BasicType BasicTypeValue basicType) = BasicTypeValue -> Text decoderForBasicType BasicTypeValue basicType decoderForFieldType (ComplexType ComplexTypeValue complexType) = ComplexTypeValue -> Text decoderForComplexType ComplexTypeValue complexType decoderForFieldType (DefinitionReferenceType DefinitionReference definitionReference) = DefinitionReference -> Text decoderForDefinitionReference DefinitionReference definitionReference decoderForFieldType (TypeVariableReferenceType (TypeVariable Text name)) = Text "decode" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text name decoderForFieldType (RecursiveReferenceType (DefinitionName Text name)) = Text name Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".Decoder" decoderForBasicType :: BasicTypeValue -> Text decoderForBasicType :: BasicTypeValue -> Text decoderForBasicType BasicTypeValue BasicString = Text "Decode.string" decoderForBasicType BasicTypeValue U8 = Text "Decode.byte" decoderForBasicType BasicTypeValue U16 = Text "Decode.uint16" decoderForBasicType BasicTypeValue U32 = Text "Decode.uint32" decoderForBasicType BasicTypeValue U64 = Text "Decode.uint64" decoderForBasicType BasicTypeValue U128 = Text "Decode.uint128" decoderForBasicType BasicTypeValue I8 = Text "Decode.int8" decoderForBasicType BasicTypeValue I16 = Text "Decode.int16" decoderForBasicType BasicTypeValue I32 = Text "Decode.int32" decoderForBasicType BasicTypeValue I64 = Text "Decode.int64" decoderForBasicType BasicTypeValue I128 = Text "Decode.int128" decoderForBasicType BasicTypeValue F32 = Text "Decode.float32" decoderForBasicType BasicTypeValue F64 = Text "Decode.float64" decoderForBasicType BasicTypeValue Boolean = Text "Decode.bool" decoderForLiteralType :: LiteralTypeValue -> Text decoderForLiteralType :: LiteralTypeValue -> Text decoderForLiteralType (LiteralString Text s) = Text "(GotynoCoders.decodeLiteralString \"" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text s Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\")" decoderForLiteralType (LiteralInteger Integer i) = Text "(GotynoCoders.decodeLiteralInteger " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Integer -> Text forall a. Show a => a -> Text tshow Integer i Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ")" decoderForLiteralType (LiteralFloat Float f) = Text "(GotynoCoders.decodeLiteralFloat " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Float -> Text forall a. Show a => a -> Text tshow Float f Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ")" decoderForLiteralType (LiteralBoolean Bool b) = Text "(GotynoCoders.decodeLiteralBoolean " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -> Text -> Bool -> Text forall a. a -> a -> Bool -> a bool Text "false" Text "true" Bool b Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ")" decoderForComplexType :: ComplexTypeValue -> Text decoderForComplexType :: ComplexTypeValue -> Text decoderForComplexType (PointerType FieldType fieldType) = FieldType -> Text decoderForFieldType FieldType fieldType decoderForComplexType (ArrayType Integer _size FieldType fieldType) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "(Decode.list ", FieldType -> Text decoderForFieldType FieldType fieldType, Text ")"] decoderForComplexType (SliceType FieldType fieldType) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "(Decode.list ", FieldType -> Text decoderForFieldType FieldType fieldType, Text ")"] decoderForComplexType (OptionalType FieldType fieldType) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "(Decode.option ", FieldType -> Text decoderForFieldType FieldType fieldType, Text ")"] decoderForDefinitionReference :: DefinitionReference -> Text decoderForDefinitionReference :: DefinitionReference -> Text decoderForDefinitionReference ( DefinitionReference (TypeDefinition (DefinitionName Text name) TypeData _typeData) ) = Text name Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".Decoder" decoderForDefinitionReference ( ImportedDefinitionReference (ModuleName Text moduleName) (TypeDefinition (DefinitionName Text name) TypeData _typeData) ) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text -> Text haskellifyModuleName Text moduleName, Text ".", Text name, Text ".Decoder"] decoderForDefinitionReference ( AppliedGenericReference [FieldType] appliedTypes (TypeDefinition (DefinitionName Text name) TypeData _typeData) ) = let appliedDecoders :: Text appliedDecoders = [FieldType] appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (FieldType -> Text) -> [FieldType] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap FieldType -> Text decoderForFieldType [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 name, Text ".Decoder ", Text appliedDecoders, Text ")"] decoderForDefinitionReference ( AppliedImportedGenericReference (ModuleName Text moduleName) (AppliedTypes [FieldType] appliedTypes) (TypeDefinition (DefinitionName Text name) TypeData _typeData) ) = let appliedDecoders :: Text appliedDecoders = [FieldType] appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (FieldType -> Text) -> [FieldType] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap FieldType -> Text decoderForFieldType [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 -> Text haskellifyModuleName Text moduleName, Text ".", Text name, Text ".Decoder ", Text appliedDecoders, Text ")"] decoderForDefinitionReference ( GenericDeclarationReference (ModuleName Text moduleName) (DefinitionName Text name) (AppliedTypes [FieldType] appliedTypes) ) = let appliedDecoders :: Text appliedDecoders = [FieldType] appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (FieldType -> Text) -> [FieldType] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap FieldType -> Text decoderForFieldType [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 -> Text haskellifyModuleName Text moduleName, Text ".", Text name, Text ".Decoder ", Text appliedDecoders, Text ")"] decoderForDefinitionReference (DeclarationReference (ModuleName Text moduleName) (DefinitionName Text name)) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text -> Text haskellifyModuleName Text moduleName, Text ".", Text name, Text ".Decoder"] encoderForFieldType :: (Text, Text) -> FieldType -> Text encoderForFieldType :: (Text, Text) -> FieldType -> Text encoderForFieldType (Text _l, Text _r) (LiteralType LiteralTypeValue literalType) = LiteralTypeValue -> Text encoderForLiteralType LiteralTypeValue literalType encoderForFieldType (Text _l, Text _r) (BasicType BasicTypeValue basicType) = BasicTypeValue -> Text encoderForBasicType BasicTypeValue basicType encoderForFieldType (Text _l, Text _r) (ComplexType complexType :: ComplexTypeValue complexType@(PointerType FieldType _)) = ComplexTypeValue -> Text encoderForComplexType ComplexTypeValue complexType encoderForFieldType (Text l, Text r) (ComplexType ComplexTypeValue complexType) = Text l Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ComplexTypeValue -> Text encoderForComplexType ComplexTypeValue complexType Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text r encoderForFieldType (Text _l, Text _r) (DefinitionReferenceType DefinitionReference definitionReference) = DefinitionReference -> Text encoderForDefinitionReference DefinitionReference definitionReference encoderForFieldType (Text _l, Text _r) (TypeVariableReferenceType (TypeVariable Text name)) = Text "encode" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text name encoderForFieldType (Text _l, Text _r) (RecursiveReferenceType (DefinitionName Text name)) = Text name Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".Encoder" encoderForBasicType :: BasicTypeValue -> Text encoderForBasicType :: BasicTypeValue -> Text encoderForBasicType BasicTypeValue BasicString = Text "Encode.string" encoderForBasicType BasicTypeValue U8 = Text "Encode.byte" encoderForBasicType BasicTypeValue U16 = Text "Encode.uint16" encoderForBasicType BasicTypeValue U32 = Text "Encode.uint32" encoderForBasicType BasicTypeValue U64 = Text "Encode.uint64" encoderForBasicType BasicTypeValue U128 = Text "Encode.uint128" encoderForBasicType BasicTypeValue I8 = Text "Encode.int8" encoderForBasicType BasicTypeValue I16 = Text "Encode.int16" encoderForBasicType BasicTypeValue I32 = Text "Encode.int32" encoderForBasicType BasicTypeValue I64 = Text "Encode.int64" encoderForBasicType BasicTypeValue I128 = Text "Encode.int128" encoderForBasicType BasicTypeValue F32 = Text "Encode.float32" encoderForBasicType BasicTypeValue F64 = Text "Encode.float64" encoderForBasicType BasicTypeValue Boolean = Text "Encode.bool" encoderForLiteralType :: LiteralTypeValue -> Text encoderForLiteralType :: LiteralTypeValue -> Text encoderForLiteralType (LiteralString Text s) = Text "Encode.string \"" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text s Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\"" encoderForLiteralType (LiteralInteger Integer i) = Text "Encode.int32 " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Integer -> Text forall a. Show a => a -> Text tshow Integer i encoderForLiteralType (LiteralFloat Float f) = Text "Encode.float32 " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Float -> Text forall a. Show a => a -> Text tshow Float f encoderForLiteralType (LiteralBoolean Bool b) = Text "Encode.bool " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -> Text -> Bool -> Text forall a. a -> a -> Bool -> a bool Text "false" Text "true" Bool b encoderForComplexType :: ComplexTypeValue -> Text encoderForComplexType :: ComplexTypeValue -> Text encoderForComplexType (PointerType FieldType fieldType) = (Text, Text) -> FieldType -> Text encoderForFieldType (Text "", Text "") FieldType fieldType encoderForComplexType (ArrayType Integer _size FieldType fieldType) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "GotynoCoders.encodeList ", (Text, Text) -> FieldType -> Text encoderForFieldType (Text "(", Text ")") FieldType fieldType] encoderForComplexType (SliceType FieldType fieldType) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "GotynoCoders.encodeList ", (Text, Text) -> FieldType -> Text encoderForFieldType (Text "(", Text ")") FieldType fieldType] encoderForComplexType (OptionalType FieldType fieldType) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "Encode.option ", (Text, Text) -> FieldType -> Text encoderForFieldType (Text "(", Text ")") FieldType fieldType, Text ""] encoderForDefinitionReference :: DefinitionReference -> Text encoderForDefinitionReference :: DefinitionReference -> Text encoderForDefinitionReference ( DefinitionReference (TypeDefinition (DefinitionName Text name) TypeData _typeData) ) = Text name Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".Encoder" encoderForDefinitionReference ( ImportedDefinitionReference (ModuleName Text moduleName) (TypeDefinition (DefinitionName Text name) TypeData _typeData) ) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text -> Text haskellifyModuleName Text moduleName, Text ".", Text name, Text ".Encoder"] encoderForDefinitionReference ( AppliedGenericReference [FieldType] appliedTypes (TypeDefinition (DefinitionName Text name) TypeData _typeData) ) = let appliedEncoders :: Text appliedEncoders = [FieldType] appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (FieldType -> Text) -> [FieldType] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((Text, Text) -> FieldType -> Text encoderForFieldType (Text "", Text "")) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text " " in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "(", Text name, Text ".Encoder ", Text appliedEncoders, Text ")"] encoderForDefinitionReference ( AppliedImportedGenericReference (ModuleName Text moduleName) (AppliedTypes [FieldType] appliedTypes) (TypeDefinition (DefinitionName Text name) TypeData _typeData) ) = let appliedEncoders :: Text appliedEncoders = [FieldType] appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (FieldType -> Text) -> [FieldType] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((Text, Text) -> FieldType -> Text encoderForFieldType (Text "", Text "")) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text " " in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "(", Text -> Text haskellifyModuleName Text moduleName, Text ".", Text name, Text ".Encoder ", Text appliedEncoders, Text ")"] encoderForDefinitionReference ( GenericDeclarationReference (ModuleName Text moduleName) (DefinitionName Text name) (AppliedTypes [FieldType] appliedTypes) ) = let appliedEncoders :: Text appliedEncoders = [FieldType] appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (FieldType -> Text) -> [FieldType] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((Text, Text) -> FieldType -> Text encoderForFieldType (Text "", Text "")) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text " " in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "(", Text -> Text haskellifyModuleName Text moduleName, Text ".", Text name, Text ".Encoder ", Text appliedEncoders, Text ")"] encoderForDefinitionReference (DeclarationReference (ModuleName Text moduleName) (DefinitionName Text name)) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text -> Text haskellifyModuleName Text moduleName, Text ".", Text name, Text ".Encoder"] 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 decoderOutput :: Text decoderOutput = FieldName -> Text -> [Constructor] -> [TypeVariable] -> Text outputUnionDecoder FieldName typeTag Text name (UnionType -> [Constructor] constructorsFrom UnionType unionType) [TypeVariable] typeVariables encoderOutput :: Text encoderOutput = FieldName -> [Constructor] -> [TypeVariable] -> Text outputUnionEncoder FieldName typeTag (UnionType -> [Constructor] constructorsFrom UnionType unionType) [TypeVariable] typeVariables typeVariables :: [TypeVariable] typeVariables = case UnionType unionType of PlainUnion [Constructor] _constructors -> [] GenericUnion [TypeVariable] ts [Constructor] _constructors -> [TypeVariable] ts in Text -> [Text] -> Text Text.intercalate Text "\n\n" [ Text caseUnionOutput, Text decoderOutput, Text encoderOutput ] outputUnionDecoder :: FieldName -> Text -> [Constructor] -> [TypeVariable] -> Text outputUnionDecoder :: FieldName -> Text -> [Constructor] -> [TypeVariable] -> Text outputUnionDecoder (FieldName Text tag) Text unionName [Constructor] constructors [TypeVariable] typeVariables = let constructorDecodersOutput :: Text constructorDecodersOutput = [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 -> [TypeVariable] -> Constructor -> Text outputConstructorDecoder Text unionName [TypeVariable] typeVariables) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n\n" tagAndDecoderOutput :: Text tagAndDecoderOutput = [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 payload) -> let payloadTypeVariables :: [TypeVariable] payloadTypeVariables = [TypeVariable] -> Maybe [TypeVariable] -> [TypeVariable] forall a. a -> Maybe a -> a fromMaybe [] (Maybe [TypeVariable] -> [TypeVariable]) -> Maybe [TypeVariable] -> [TypeVariable] forall a b. (a -> b) -> a -> b $ (FieldType -> Maybe [TypeVariable]) -> Maybe FieldType -> Maybe [TypeVariable] forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap FieldType -> Maybe [TypeVariable] typeVariablesFrom Maybe FieldType payload maybeDecoderArguments :: Text maybeDecoderArguments = [TypeVariable] -> Text typeVariableDecodersAsArguments [TypeVariable] payloadTypeVariables in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text " \"", Text name, Text "\", ", Text unionName, Text ".", Text -> Text upperCaseFirstCharacter Text name, Text "Decoder", Text maybeDecoderArguments, Text "\n" ] ) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & [Text] -> Text forall a. Monoid a => [a] -> a mconcat fullName :: Text fullName = if [TypeVariable] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [TypeVariable] typeVariables then Text unionName else [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text unionName, [TypeVariable] -> Text joinTypeVariables [TypeVariable] typeVariables] maybeArguments :: Text maybeArguments = [TypeVariable] -> Text typeVariableDecodersAsArguments [TypeVariable] typeVariables in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text constructorDecodersOutput, Text "\n\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member Decoder", Text maybeArguments, Text ": Decoder<", Text fullName, Text "> =\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " GotynoCoders.decodeWithTypeTag\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " \"", Text tag, Text "\"\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " [|\n"], Text tagAndDecoderOutput, [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " |]"] ] typeVariableDecodersAsArguments :: [TypeVariable] -> Text typeVariableDecodersAsArguments :: [TypeVariable] -> Text typeVariableDecodersAsArguments [] = Text "" typeVariableDecodersAsArguments [TypeVariable] typeVariables = Text " " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ([TypeVariable] -> [Text] decodersForTypeVariables [TypeVariable] typeVariables [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text " ") decodersForTypeVariables :: [TypeVariable] -> [Text] decodersForTypeVariables :: [TypeVariable] -> [Text] decodersForTypeVariables = (TypeVariable -> Text) -> [TypeVariable] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (TypeVariable -> FieldType TypeVariableReferenceType (TypeVariable -> FieldType) -> (FieldType -> Text) -> TypeVariable -> Text forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> FieldType -> Text decoderForFieldType) typeVariableEncodersAsArguments :: [TypeVariable] -> Text typeVariableEncodersAsArguments :: [TypeVariable] -> Text typeVariableEncodersAsArguments [] = Text "" typeVariableEncodersAsArguments [TypeVariable] typeVariables = Text " " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ([TypeVariable] -> [Text] encodersForTypeVariables [TypeVariable] typeVariables [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text " ") encodersForTypeVariables :: [TypeVariable] -> [Text] encodersForTypeVariables :: [TypeVariable] -> [Text] encodersForTypeVariables = (TypeVariable -> Text) -> [TypeVariable] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (TypeVariable -> FieldType TypeVariableReferenceType (TypeVariable -> FieldType) -> (FieldType -> Text) -> TypeVariable -> Text forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Text, Text) -> FieldType -> Text encoderForFieldType (Text "", Text "")) outputConstructorDecoder :: Text -> [TypeVariable] -> Constructor -> Text outputConstructorDecoder :: Text -> [TypeVariable] -> Constructor -> Text outputConstructorDecoder Text unionName [TypeVariable] typeVariables (Constructor (ConstructorName Text name) Maybe FieldType maybePayload) = let decoder :: Text decoder = Text -> (FieldType -> Text) -> Maybe FieldType -> Text forall b a. b -> (a -> b) -> Maybe a -> b maybe Text alwaysSucceedingDecoder FieldType -> Text decoderWithDataField Maybe FieldType maybePayload constructorName :: Text constructorName = Text -> Text upperCaseFirstCharacter Text name alwaysSucceedingDecoder :: Text alwaysSucceedingDecoder = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "Decode.succeed ", Text constructorName] payloadTypeVariables :: [TypeVariable] payloadTypeVariables = [TypeVariable] -> Maybe [TypeVariable] -> [TypeVariable] forall a. a -> Maybe a -> a fromMaybe [] (Maybe [TypeVariable] -> [TypeVariable]) -> Maybe [TypeVariable] -> [TypeVariable] forall a b. (a -> b) -> a -> b $ (FieldType -> Maybe [TypeVariable]) -> Maybe FieldType -> Maybe [TypeVariable] forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap FieldType -> Maybe [TypeVariable] typeVariablesFrom Maybe FieldType maybePayload maybeArguments :: Text maybeArguments = [TypeVariable] -> Text typeVariableDecodersAsArguments [TypeVariable] payloadTypeVariables fullName :: Text fullName = if [TypeVariable] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [TypeVariable] typeVariables then Text unionName else [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text unionName, [TypeVariable] -> Text joinTypeVariables [TypeVariable] typeVariables] decoderWithDataField :: FieldType -> Text decoderWithDataField FieldType payload = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text "Decode.object (fun get -> ", Text constructorName, Text "(get.Required.Field \"data\" ", FieldType -> Text decoderForFieldType FieldType payload, Text "))" ] in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ Text " static member ", Text constructorName, Text "Decoder", Text maybeArguments, Text ": Decoder<", Text fullName, Text "> =\n" ], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " ", Text decoder] ] outputUnionEncoder :: FieldName -> [Constructor] -> [TypeVariable] -> Text outputUnionEncoder :: FieldName -> [Constructor] -> [TypeVariable] -> Text outputUnionEncoder FieldName typeTag [Constructor] constructors [TypeVariable] typeVariables = let caseEncodingOutput :: Text caseEncodingOutput = [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 (FieldName -> Constructor -> Text outputConstructorEncoder FieldName typeTag) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n\n" maybeArguments :: Text maybeArguments = [TypeVariable] -> Text typeVariableEncodersAsArguments [TypeVariable] typeVariables in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " static member Encoder", Text maybeArguments, Text " =\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " function\n"], Text caseEncodingOutput ] outputConstructorEncoder :: FieldName -> Constructor -> Text outputConstructorEncoder :: FieldName -> Constructor -> Text outputConstructorEncoder (FieldName Text tag) (Constructor (ConstructorName Text name) Maybe FieldType maybePayload) = let dataPart :: Text dataPart = Text -> (FieldType -> Text) -> Maybe FieldType -> Text forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "" FieldType -> Text encoderWithDataField Maybe FieldType maybePayload typeTagPart :: Text typeTagPart = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "\"", Text tag, Text "\", Encode.string \"", Text name, Text "\""] dataIndentation :: Text dataIndentation = Text " " encoderWithDataField :: FieldType -> Text encoderWithDataField FieldType payload = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "\n", Text dataIndentation, Text "\"data\", ", (Text, Text) -> FieldType -> Text encoderForFieldType (Text "", Text "") FieldType payload, Text " payload"] interface :: Text interface = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "[ ", Text typeTagPart, Text dataPart, Text " ]"] maybePayloadPart :: Text maybePayloadPart = Text -> (FieldType -> Text) -> Maybe FieldType -> Text forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "" (Text -> FieldType -> Text forall a b. a -> b -> a const Text " payload") Maybe FieldType maybePayload in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [ [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " | ", Text -> Text upperCaseFirstCharacter Text name, Text maybePayloadPart, Text " ->\n"], [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " Encode.object ", Text interface] ] 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) -> let payload :: Text payload = Text -> (FieldType -> Text) -> Maybe FieldType -> Text forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "" (FieldType -> Text outputFieldType (FieldType -> Text) -> (Text -> Text) -> FieldType -> Text forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Text " of " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <>)) Maybe FieldType maybePayload in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text " | ", Text -> Text upperCaseFirstCharacter Text constructorName, Text payload] ) [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text "\n" 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] -> Text forall a. Monoid a => [a] -> a mconcat [Text "type ", Text name, Text maybeTypeVariables, Text " =\n"], Text cases ] typeVariablesFrom :: FieldType -> Maybe [TypeVariable] typeVariablesFrom :: FieldType -> Maybe [TypeVariable] typeVariablesFrom (TypeVariableReferenceType TypeVariable typeVariable) = [TypeVariable] -> Maybe [TypeVariable] forall (f :: * -> *) a. Applicative f => a -> f a pure [TypeVariable typeVariable] typeVariablesFrom (ComplexType (ArrayType Integer _size FieldType fieldType)) = FieldType -> Maybe [TypeVariable] typeVariablesFrom FieldType fieldType typeVariablesFrom (ComplexType (SliceType FieldType fieldType)) = FieldType -> Maybe [TypeVariable] typeVariablesFrom FieldType fieldType typeVariablesFrom (ComplexType (PointerType FieldType fieldType)) = FieldType -> Maybe [TypeVariable] typeVariablesFrom FieldType fieldType typeVariablesFrom (ComplexType (OptionalType FieldType fieldType)) = FieldType -> Maybe [TypeVariable] typeVariablesFrom FieldType fieldType typeVariablesFrom (RecursiveReferenceType DefinitionName _name) = Maybe [TypeVariable] forall a. Maybe a Nothing typeVariablesFrom (LiteralType LiteralTypeValue _) = Maybe [TypeVariable] forall a. Maybe a Nothing typeVariablesFrom (BasicType BasicTypeValue _) = Maybe [TypeVariable] forall a. Maybe a Nothing typeVariablesFrom (DefinitionReferenceType DefinitionReference definitionReference) = DefinitionReference -> Maybe [TypeVariable] typeVariablesFromReference DefinitionReference definitionReference typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable] typeVariablesFromReference :: DefinitionReference -> Maybe [TypeVariable] typeVariablesFromReference (DefinitionReference TypeDefinition definition) = TypeDefinition -> Maybe [TypeVariable] typeVariablesFromDefinition TypeDefinition definition typeVariablesFromReference (ImportedDefinitionReference ModuleName _moduleName TypeDefinition definition) = TypeDefinition -> Maybe [TypeVariable] typeVariablesFromDefinition TypeDefinition definition typeVariablesFromReference (AppliedGenericReference [FieldType] fieldTypes TypeDefinition _definition) = let typeVariables :: [TypeVariable] typeVariables = [FieldType] fieldTypes [FieldType] -> ([FieldType] -> [Maybe [TypeVariable]]) -> [Maybe [TypeVariable]] forall a b. a -> (a -> b) -> b & (FieldType -> Maybe [TypeVariable]) -> [FieldType] -> [Maybe [TypeVariable]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap FieldType -> Maybe [TypeVariable] typeVariablesFrom [Maybe [TypeVariable]] -> ([Maybe [TypeVariable]] -> [[TypeVariable]]) -> [[TypeVariable]] forall a b. a -> (a -> b) -> b & [Maybe [TypeVariable]] -> [[TypeVariable]] forall a. [Maybe a] -> [a] catMaybes [[TypeVariable]] -> ([[TypeVariable]] -> [TypeVariable]) -> [TypeVariable] forall a b. a -> (a -> b) -> b & [[TypeVariable]] -> [TypeVariable] forall (m :: * -> *) a. Monad m => m (m a) -> m a join in if [TypeVariable] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [TypeVariable] typeVariables then Maybe [TypeVariable] forall a. Maybe a Nothing else [TypeVariable] -> Maybe [TypeVariable] forall a. a -> Maybe a Just [TypeVariable] typeVariables typeVariablesFromReference ( AppliedImportedGenericReference ModuleName _moduleName (AppliedTypes [FieldType] fieldTypes) TypeDefinition _definition ) = let typeVariables :: [TypeVariable] typeVariables = [FieldType] fieldTypes [FieldType] -> ([FieldType] -> [Maybe [TypeVariable]]) -> [Maybe [TypeVariable]] forall a b. a -> (a -> b) -> b & (FieldType -> Maybe [TypeVariable]) -> [FieldType] -> [Maybe [TypeVariable]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap FieldType -> Maybe [TypeVariable] typeVariablesFrom [Maybe [TypeVariable]] -> ([Maybe [TypeVariable]] -> [[TypeVariable]]) -> [[TypeVariable]] forall a b. a -> (a -> b) -> b & [Maybe [TypeVariable]] -> [[TypeVariable]] forall a. [Maybe a] -> [a] catMaybes [[TypeVariable]] -> ([[TypeVariable]] -> [TypeVariable]) -> [TypeVariable] forall a b. a -> (a -> b) -> b & [[TypeVariable]] -> [TypeVariable] forall (m :: * -> *) a. Monad m => m (m a) -> m a join in if [TypeVariable] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [TypeVariable] typeVariables then Maybe [TypeVariable] forall a. Maybe a Nothing else [TypeVariable] -> Maybe [TypeVariable] forall a. a -> Maybe a Just [TypeVariable] typeVariables typeVariablesFromReference ( GenericDeclarationReference ModuleName _moduleName DefinitionName _definitionName (AppliedTypes [FieldType] fieldTypes) ) = let typeVariables :: [TypeVariable] typeVariables = [FieldType] fieldTypes [FieldType] -> ([FieldType] -> [Maybe [TypeVariable]]) -> [Maybe [TypeVariable]] forall a b. a -> (a -> b) -> b & (FieldType -> Maybe [TypeVariable]) -> [FieldType] -> [Maybe [TypeVariable]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap FieldType -> Maybe [TypeVariable] typeVariablesFrom [Maybe [TypeVariable]] -> ([Maybe [TypeVariable]] -> [[TypeVariable]]) -> [[TypeVariable]] forall a b. a -> (a -> b) -> b & [Maybe [TypeVariable]] -> [[TypeVariable]] forall a. [Maybe a] -> [a] catMaybes [[TypeVariable]] -> ([[TypeVariable]] -> [TypeVariable]) -> [TypeVariable] forall a b. a -> (a -> b) -> b & [[TypeVariable]] -> [TypeVariable] forall (m :: * -> *) a. Monad m => m (m a) -> m a join in if [TypeVariable] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [TypeVariable] typeVariables then Maybe [TypeVariable] forall a. Maybe a Nothing else [TypeVariable] -> Maybe [TypeVariable] forall a. a -> Maybe a Just [TypeVariable] typeVariables typeVariablesFromReference (DeclarationReference ModuleName _moduleName DefinitionName _definitionName) = Maybe [TypeVariable] forall a. Maybe a Nothing typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable] typeVariablesFromDefinition :: TypeDefinition -> Maybe [TypeVariable] typeVariablesFromDefinition (TypeDefinition DefinitionName _name (Struct (PlainStruct [StructField] _))) = Maybe [TypeVariable] forall a. Maybe a Nothing typeVariablesFromDefinition (TypeDefinition DefinitionName _name (Union FieldName _tagType (PlainUnion [Constructor] _))) = Maybe [TypeVariable] forall a. Maybe a Nothing typeVariablesFromDefinition (TypeDefinition DefinitionName _name (UntaggedUnion [FieldType] _)) = Maybe [TypeVariable] forall a. Maybe a Nothing typeVariablesFromDefinition (TypeDefinition DefinitionName _name (Enumeration [EnumerationValue] _)) = Maybe [TypeVariable] forall a. Maybe a Nothing typeVariablesFromDefinition (TypeDefinition DefinitionName _name (EmbeddedUnion FieldName _tagType [EmbeddedConstructor] _constructors)) = Maybe [TypeVariable] forall a. Maybe a Nothing typeVariablesFromDefinition (TypeDefinition DefinitionName _name (Struct (GenericStruct [TypeVariable] typeVariables [StructField] _))) = [TypeVariable] -> Maybe [TypeVariable] forall (f :: * -> *) a. Applicative f => a -> f a pure [TypeVariable] typeVariables typeVariablesFromDefinition (TypeDefinition DefinitionName _name (Union FieldName _tagType (GenericUnion [TypeVariable] typeVariables [Constructor] _))) = [TypeVariable] -> Maybe [TypeVariable] forall (f :: * -> *) a. Applicative f => a -> f a pure [TypeVariable] typeVariables typeVariablesFromDefinition (TypeDefinition DefinitionName _name (DeclaredType ModuleName _moduleName [TypeVariable] typeVariables)) = [TypeVariable] -> Maybe [TypeVariable] forall (f :: * -> *) a. Applicative f => a -> f a pure [TypeVariable] typeVariables outputField :: Int -> StructField -> Text outputField :: Int -> StructField -> Text outputField Int indentation (StructField (FieldName Text name) FieldType fieldType) = let indent :: Text indent = [Char] -> Text Text.pack ([Char] -> Text) -> [Char] -> Text forall a b. (a -> b) -> a -> b $ Int -> Char -> [Char] forall a. Int -> a -> [a] replicate Int indentation Char ' ' in Text indent Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text -> Text upperCaseFirstCharacter Text name, Text ": ", FieldType -> Text outputFieldType FieldType fieldType, Text "\n"] outputFieldType :: FieldType -> Text outputFieldType :: FieldType -> Text outputFieldType (LiteralType (LiteralString Text _text)) = BasicTypeValue -> Text outputBasicType BasicTypeValue BasicString outputFieldType (LiteralType (LiteralInteger Integer _x)) = BasicTypeValue -> Text outputBasicType BasicTypeValue I32 outputFieldType (LiteralType (LiteralFloat Float _f)) = BasicTypeValue -> Text outputBasicType BasicTypeValue F32 outputFieldType (LiteralType (LiteralBoolean Bool _b)) = BasicTypeValue -> Text outputBasicType BasicTypeValue Boolean outputFieldType (BasicType BasicTypeValue basicType) = BasicTypeValue -> Text outputBasicType BasicTypeValue basicType outputFieldType (ComplexType (OptionalType FieldType fieldType)) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "option<", FieldType -> Text outputFieldType FieldType fieldType, Text ">"] outputFieldType (ComplexType (ArrayType Integer _size FieldType fieldType)) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "list<", FieldType -> Text outputFieldType FieldType fieldType, Text ">"] outputFieldType (ComplexType (SliceType FieldType fieldType)) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "list<", FieldType -> Text outputFieldType FieldType fieldType, Text ">"] outputFieldType (ComplexType (PointerType FieldType fieldType)) = FieldType -> Text outputFieldType FieldType fieldType outputFieldType (RecursiveReferenceType (DefinitionName Text name)) = Text name outputFieldType (DefinitionReferenceType DefinitionReference definitionReference) = DefinitionReference -> Text outputDefinitionReference DefinitionReference definitionReference outputFieldType (TypeVariableReferenceType (TypeVariable Text t)) = Text -> Text fsharpifyTypeVariable Text t fsharpifyTypeVariable :: Text -> Text fsharpifyTypeVariable :: Text -> Text fsharpifyTypeVariable Text t = Text t Text -> (Text -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> Text Text.toLower Text -> (Text -> Text) -> Text forall a b. a -> (a -> b) -> b & (Text "'" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <>) 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 -> Text haskellifyModuleName 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 -> Text haskellifyModuleName Text moduleName, Text ".", Text name, Text "<", Text appliedFieldTypes, Text ">"] outputDefinitionReference ( GenericDeclarationReference (ModuleName Text moduleName) (DefinitionName Text name) (AppliedTypes [FieldType] appliedTypes) ) = let appliedFieldTypes :: Text appliedFieldTypes = [FieldType] appliedTypes [FieldType] -> ([FieldType] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (FieldType -> Text) -> [FieldType] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap FieldType -> Text outputFieldType [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> [Text] -> Text Text.intercalate Text ", " maybeAppliedOutput :: Text maybeAppliedOutput = if [FieldType] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [FieldType] appliedTypes then Text "" else [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text "<", Text appliedFieldTypes, Text ">"] in [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text -> Text haskellifyModuleName 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 -> Text haskellifyModuleName Text moduleName, Text ".", Text name] outputBasicType :: BasicTypeValue -> Text outputBasicType :: BasicTypeValue -> Text outputBasicType BasicTypeValue BasicString = Text "string" outputBasicType BasicTypeValue U8 = Text "uint8" outputBasicType BasicTypeValue U16 = Text "uint16" outputBasicType BasicTypeValue U32 = Text "uint32" outputBasicType BasicTypeValue U64 = Text "uint64" outputBasicType BasicTypeValue U128 = Text "uint128" outputBasicType BasicTypeValue I8 = Text "int8" outputBasicType BasicTypeValue I16 = Text "int16" outputBasicType BasicTypeValue I32 = Text "int32" outputBasicType BasicTypeValue I64 = Text "int64" outputBasicType BasicTypeValue I128 = Text "int128" outputBasicType BasicTypeValue F32 = Text "float32" outputBasicType BasicTypeValue F64 = Text "float64" outputBasicType BasicTypeValue Boolean = Text "bool" fieldTypeName :: FieldType -> Text fieldTypeName :: FieldType -> Text fieldTypeName (LiteralType LiteralTypeValue _) = [Char] -> Text forall a. HasCallStack => [Char] -> a error [Char] "Just don't use literals in untagged unions" fieldTypeName (RecursiveReferenceType DefinitionName _) = [Char] -> Text forall a. HasCallStack => [Char] -> a error [Char] "Just don't use recursive references in untagged unions" fieldTypeName (BasicType BasicTypeValue BasicString) = Text "String" fieldTypeName (BasicType BasicTypeValue F32) = Text "F32" fieldTypeName (BasicType BasicTypeValue F64) = Text "F64" fieldTypeName (BasicType BasicTypeValue U8) = Text "U8" fieldTypeName (BasicType BasicTypeValue U16) = Text "U16" fieldTypeName (BasicType BasicTypeValue U32) = Text "U32" fieldTypeName (BasicType BasicTypeValue U64) = Text "U64" fieldTypeName (BasicType BasicTypeValue U128) = Text "U128" fieldTypeName (BasicType BasicTypeValue I8) = Text "I8" fieldTypeName (BasicType BasicTypeValue I16) = Text "I16" fieldTypeName (BasicType BasicTypeValue I32) = Text "I32" fieldTypeName (BasicType BasicTypeValue I64) = Text "I64" fieldTypeName (BasicType BasicTypeValue I128) = Text "I128" fieldTypeName (BasicType BasicTypeValue Boolean) = Text "Boolean" fieldTypeName (TypeVariableReferenceType (TypeVariable Text t)) = Text t fieldTypeName (ComplexType (ArrayType Integer _ FieldType arrayFieldType)) = Text "ArrayOf" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> FieldType -> Text fieldTypeName FieldType arrayFieldType fieldTypeName (ComplexType (SliceType FieldType sliceFieldType)) = Text "SliceOf" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> FieldType -> Text fieldTypeName FieldType sliceFieldType fieldTypeName (ComplexType (PointerType FieldType pointerFieldType)) = FieldType -> Text fieldTypeName FieldType pointerFieldType fieldTypeName (ComplexType (OptionalType FieldType optionalFieldType)) = Text "OptionalOf" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> FieldType -> Text fieldTypeName FieldType optionalFieldType fieldTypeName ( DefinitionReferenceType (DefinitionReference (TypeDefinition (DefinitionName Text definitionName) TypeData _)) ) = Text definitionName fieldTypeName ( DefinitionReferenceType (ImportedDefinitionReference ModuleName _ (TypeDefinition (DefinitionName Text definitionName) TypeData _)) ) = Text definitionName fieldTypeName ( DefinitionReferenceType ( AppliedGenericReference [FieldType] fieldTypes (TypeDefinition (DefinitionName Text definitionName) TypeData _) ) ) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text definitionName, Text "Of", [FieldType] fieldTypes [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 fieldTypeName [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & [Text] -> Text forall a. Monoid a => [a] -> a mconcat] fieldTypeName ( DefinitionReferenceType ( AppliedImportedGenericReference ModuleName _moduleName (AppliedTypes [FieldType] fieldTypes) (TypeDefinition (DefinitionName Text definitionName) TypeData _) ) ) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text definitionName, Text "Of", [FieldType] fieldTypes [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 fieldTypeName [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & [Text] -> Text forall a. Monoid a => [a] -> a mconcat] fieldTypeName ( DefinitionReferenceType ( GenericDeclarationReference (ModuleName Text _moduleName) (DefinitionName Text definitionName) (AppliedTypes [FieldType] fieldTypes) ) ) = [Text] -> Text forall a. Monoid a => [a] -> a mconcat [Text definitionName, Text "Of", [FieldType] fieldTypes [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 fieldTypeName [Text] -> ([Text] -> Text) -> Text forall a b. a -> (a -> b) -> b & [Text] -> Text forall a. Monoid a => [a] -> a mconcat] fieldTypeName (DefinitionReferenceType (DeclarationReference ModuleName _moduleName (DefinitionName Text definitionName))) = Text definitionName joinTypeVariables :: [TypeVariable] -> Text joinTypeVariables :: [TypeVariable] -> Text joinTypeVariables [TypeVariable] typeVariables = [TypeVariable] typeVariables [TypeVariable] -> ([TypeVariable] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (TypeVariable -> Text) -> [TypeVariable] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\(TypeVariable Text t) -> Text -> Text fsharpifyTypeVariable 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 ">")