diff --git a/.golden/kotlinAdvancedEnumSpec/golden b/.golden/kotlin-tagged-flat-object-AdvancedEnumSpec/golden similarity index 100% rename from .golden/kotlinAdvancedEnumSpec/golden rename to .golden/kotlin-tagged-flat-object-AdvancedEnumSpec/golden diff --git a/.golden/kotlinAdvancedEnumWithRawValueSpec/golden b/.golden/kotlin-tagged-flat-object-AdvancedEnumWithRawValueSpec/golden similarity index 100% rename from .golden/kotlinAdvancedEnumWithRawValueSpec/golden rename to .golden/kotlin-tagged-flat-object-AdvancedEnumWithRawValueSpec/golden diff --git a/.golden/kotlinAdvancedNewtypeSpec/golden b/.golden/kotlin-tagged-flat-object-AdvancedNewtypeSpec/golden similarity index 100% rename from .golden/kotlinAdvancedNewtypeSpec/golden rename to .golden/kotlin-tagged-flat-object-AdvancedNewtypeSpec/golden diff --git a/.golden/kotlinAdvancedNewtypeWithEnumFieldSpec/golden b/.golden/kotlin-tagged-flat-object-AdvancedNewtypeWithEnumFieldSpec/golden similarity index 100% rename from .golden/kotlinAdvancedNewtypeWithEnumFieldSpec/golden rename to .golden/kotlin-tagged-flat-object-AdvancedNewtypeWithEnumFieldSpec/golden diff --git a/.golden/kotlinAdvancedRecordSpec/golden b/.golden/kotlin-tagged-flat-object-AdvancedRecordSpec/golden similarity index 100% rename from .golden/kotlinAdvancedRecordSpec/golden rename to .golden/kotlin-tagged-flat-object-AdvancedRecordSpec/golden diff --git a/.golden/kotlinBasicEnumSpec/golden b/.golden/kotlin-tagged-flat-object-BasicEnumSpec/golden similarity index 100% rename from .golden/kotlinBasicEnumSpec/golden rename to .golden/kotlin-tagged-flat-object-BasicEnumSpec/golden diff --git a/.golden/kotlinBasicEnumWithRawValueSpec/golden b/.golden/kotlin-tagged-flat-object-BasicEnumWithRawValueSpec/golden similarity index 100% rename from .golden/kotlinBasicEnumWithRawValueSpec/golden rename to .golden/kotlin-tagged-flat-object-BasicEnumWithRawValueSpec/golden diff --git a/.golden/kotlinBasicNewtypeSpec/golden b/.golden/kotlin-tagged-flat-object-BasicNewtypeSpec/golden similarity index 100% rename from .golden/kotlinBasicNewtypeSpec/golden rename to .golden/kotlin-tagged-flat-object-BasicNewtypeSpec/golden diff --git a/.golden/kotlinBasicNewtypeWithConcreteFieldSpec/golden b/.golden/kotlin-tagged-flat-object-BasicNewtypeWithConcreteFieldSpec/golden similarity index 100% rename from .golden/kotlinBasicNewtypeWithConcreteFieldSpec/golden rename to .golden/kotlin-tagged-flat-object-BasicNewtypeWithConcreteFieldSpec/golden diff --git a/.golden/kotlinBasicNewtypeWithEitherFieldSpec/golden b/.golden/kotlin-tagged-flat-object-BasicNewtypeWithEitherFieldSpec/golden similarity index 100% rename from .golden/kotlinBasicNewtypeWithEitherFieldSpec/golden rename to .golden/kotlin-tagged-flat-object-BasicNewtypeWithEitherFieldSpec/golden diff --git a/.golden/kotlinBasicRecordSpec/golden b/.golden/kotlin-tagged-flat-object-BasicRecordSpec/golden similarity index 100% rename from .golden/kotlinBasicRecordSpec/golden rename to .golden/kotlin-tagged-flat-object-BasicRecordSpec/golden diff --git a/.golden/kotlinEnumSumOfProductSpec/golden b/.golden/kotlin-tagged-flat-object-EnumSumOfProductSpec/golden similarity index 100% rename from .golden/kotlinEnumSumOfProductSpec/golden rename to .golden/kotlin-tagged-flat-object-EnumSumOfProductSpec/golden diff --git a/.golden/kotlin-tagged-flat-object-EnumSumOfProductWithLinkEnumInterfaceSpec/golden b/.golden/kotlin-tagged-flat-object-EnumSumOfProductWithLinkEnumInterfaceSpec/golden new file mode 100644 index 0000000..41ccd4e --- /dev/null +++ b/.golden/kotlin-tagged-flat-object-EnumSumOfProductWithLinkEnumInterfaceSpec/golden @@ -0,0 +1,3 @@ +@Parcelize +@Serializable +sealed class Enum : Parcelable \ No newline at end of file diff --git a/.golden/kotlinRecord0SumOfProductWithLinkEnumInterfaceSpec/golden b/.golden/kotlin-tagged-flat-object-Record0SumOfProductWithLinkEnumInterfaceSpec/golden similarity index 87% rename from .golden/kotlinRecord0SumOfProductWithLinkEnumInterfaceSpec/golden rename to .golden/kotlin-tagged-flat-object-Record0SumOfProductWithLinkEnumInterfaceSpec/golden index be6140f..19c6cfc 100644 --- a/.golden/kotlinRecord0SumOfProductWithLinkEnumInterfaceSpec/golden +++ b/.golden/kotlin-tagged-flat-object-Record0SumOfProductWithLinkEnumInterfaceSpec/golden @@ -3,4 +3,4 @@ data class Record0( val record0Field0: Int, val record0Field1: Int, -) : Enum() \ No newline at end of file +) : Parcelable \ No newline at end of file diff --git a/.golden/kotlinRecord1SumOfProductWithLinkEnumInterfaceSpec/golden b/.golden/kotlin-tagged-flat-object-Record1SumOfProductWithLinkEnumInterfaceSpec/golden similarity index 87% rename from .golden/kotlinRecord1SumOfProductWithLinkEnumInterfaceSpec/golden rename to .golden/kotlin-tagged-flat-object-Record1SumOfProductWithLinkEnumInterfaceSpec/golden index b41148f..e1201f1 100644 --- a/.golden/kotlinRecord1SumOfProductWithLinkEnumInterfaceSpec/golden +++ b/.golden/kotlin-tagged-flat-object-Record1SumOfProductWithLinkEnumInterfaceSpec/golden @@ -3,4 +3,4 @@ data class Record1( val record1Field0: Int, val record1Field1: Int, -) : Enum() \ No newline at end of file +) : Parcelable \ No newline at end of file diff --git a/.golden/kotlin-tagged-object-EnumSumOfProductWithLinkEnumInterfaceSpec/golden b/.golden/kotlin-tagged-object-EnumSumOfProductWithLinkEnumInterfaceSpec/golden new file mode 100644 index 0000000..d297278 --- /dev/null +++ b/.golden/kotlin-tagged-object-EnumSumOfProductWithLinkEnumInterfaceSpec/golden @@ -0,0 +1,12 @@ +@JsonClassDiscriminator("tag") +sealed class Enum : Parcelable { + @Parcelize + @Serializable + @SerialName("dataCons0") + data class DataCons0(val contents: Record0) : Enum() + + @Parcelize + @Serializable + @SerialName("dataCons1") + data class DataCons1(val contents: Record1) : Enum() +} \ No newline at end of file diff --git a/.golden/kotlin-tagged-object-Record0SumOfProductWithLinkEnumInterfaceSpec/golden b/.golden/kotlin-tagged-object-Record0SumOfProductWithLinkEnumInterfaceSpec/golden new file mode 100644 index 0000000..19c6cfc --- /dev/null +++ b/.golden/kotlin-tagged-object-Record0SumOfProductWithLinkEnumInterfaceSpec/golden @@ -0,0 +1,6 @@ +@Parcelize +@Serializable +data class Record0( + val record0Field0: Int, + val record0Field1: Int, +) : Parcelable \ No newline at end of file diff --git a/.golden/kotlin-tagged-object-Record1SumOfProductWithLinkEnumInterfaceSpec/golden b/.golden/kotlin-tagged-object-Record1SumOfProductWithLinkEnumInterfaceSpec/golden new file mode 100644 index 0000000..e1201f1 --- /dev/null +++ b/.golden/kotlin-tagged-object-Record1SumOfProductWithLinkEnumInterfaceSpec/golden @@ -0,0 +1,6 @@ +@Parcelize +@Serializable +data class Record1( + val record1Field0: Int, + val record1Field1: Int, +) : Parcelable \ No newline at end of file diff --git a/.golden/kotlinEnumSumOfProductWithLinkEnumInterfaceSpec/golden b/.golden/kotlinEnumSumOfProductWithLinkEnumInterfaceSpec/golden deleted file mode 100644 index c9da784..0000000 --- a/.golden/kotlinEnumSumOfProductWithLinkEnumInterfaceSpec/golden +++ /dev/null @@ -1,2 +0,0 @@ -@Serializable(with = Enum1Serializer::class) -sealed class Enum : Parcelable \ No newline at end of file diff --git a/flake.nix b/flake.nix index 28a20d9..a80f51f 100644 --- a/flake.nix +++ b/flake.nix @@ -78,6 +78,7 @@ hpack ormolu hlint + haskell-language-server ]; } ); diff --git a/moat.cabal b/moat.cabal index 7c2ac00..092bae6 100644 --- a/moat.cabal +++ b/moat.cabal @@ -29,6 +29,8 @@ library other-modules: Moat.Class Moat.Pretty.Kotlin + Moat.Pretty.Kotlin.TaggedFlatObject + Moat.Pretty.Kotlin.TaggedObject Moat.Pretty.Swift Moat.Types Paths_moat @@ -73,6 +75,8 @@ test-suite spec Moat Moat.Class Moat.Pretty.Kotlin + Moat.Pretty.Kotlin.TaggedFlatObject + Moat.Pretty.Kotlin.TaggedObject Moat.Pretty.Swift Moat.Types Paths_moat diff --git a/src/Moat.hs b/src/Moat.hs index ba128ea..c700d2e 100644 --- a/src/Moat.hs +++ b/src/Moat.hs @@ -71,6 +71,11 @@ module Moat prettyKotlinData, prettySwiftData, + -- ** Kotlin configuration + EncodingStyle (..), + TaggedObject (..), + TaggedFlatObject (..), + -- * Utility aliasToNewtype, newtypeToAlias, @@ -95,7 +100,9 @@ import Language.Haskell.TH hiding (stringE, tupE) import Language.Haskell.TH.Datatype import qualified Language.Haskell.TH.Syntax as Syntax import Moat.Class -import Moat.Pretty.Kotlin (prettyKotlinData) +import Moat.Pretty.Kotlin (EncodingStyle (..), prettyKotlinData) +import Moat.Pretty.Kotlin.TaggedFlatObject (TaggedFlatObject (..)) +import Moat.Pretty.Kotlin.TaggedObject (TaggedObject (..)) import Moat.Pretty.Swift (prettySwiftData) import Moat.Types hiding (newtypeName) import qualified Moat.Types diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index fc2ab24..4e60b36 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -1,255 +1,25 @@ module Moat.Pretty.Kotlin ( prettyKotlinData, + EncodingStyle (..), ) where -import qualified Data.Char as Char -import Data.List (intercalate) +import qualified Moat.Pretty.Kotlin.TaggedFlatObject as TaggedFlatObject +import qualified Moat.Pretty.Kotlin.TaggedObject as TaggedObject import Moat.Types --- | Convert a 'MoatData' into a canonical representation in Kotlin +-- Aeson provides a few different encoding styles, https://hackage.haskell.org/package/aeson-2.0.1.0/docs/Data-Aeson-TH.html#t:SumEncoding +-- The original style we implemented will be called 'TaggedFlatObject' but isn't available in Aeson yet: https://github.com/haskell/aeson/pull/828 -- --- This is a decent default if you plan to do Android development, however you --- could instead use this as a template to write your own version. Or, use it --- to write an entirely new language backend :) -prettyKotlinData :: MoatData -> String -prettyKotlinData = \case - MoatStruct {..} -> - "" - ++ prettyAnnotations structAnnotations - ++ "data class " - ++ prettyMoatTypeHeader structName structTyVars - ++ "(" - ++ newlineNonEmpty structFields - ++ prettyStructFields indents structFields - ++ ")" - ++ prettyInterfaces structInterfaces - MoatEnum {..} -> - prettyEnum - enumAnnotations - enumInterfaces - enumName - enumTyVars - enumCases - indents - MoatNewtype {..} -> - "" - ++ prettyAnnotations newtypeAnnotations - ++ "inline class " - ++ prettyMoatTypeHeader newtypeName newtypeTyVars - ++ "(val " - ++ fst newtypeField - ++ ": " - ++ prettyMoatType (snd newtypeField) - ++ ")" - ++ prettyInterfaces newtypeInterfaces - MoatAlias {..} -> - "" - ++ "typealias " - ++ prettyMoatTypeHeader aliasName aliasTyVars - ++ " = " - ++ prettyMoatType aliasTyp - where - indent = 4 - indents = replicate indent ' ' - -prettyStructFields :: String -> [(String, MoatType)] -> String -prettyStructFields indents = go - where - go [] = "" - go ((fieldName, ty) : fs) = - indents - ++ "val " - ++ fieldName - ++ ": " - ++ prettyMoatType ty - ++ case ty of - Optional _ -> " = null" - _ -> "" - ++ ",\n" - ++ go fs - -prettyCEnumCases :: String -> [String] -> String -prettyCEnumCases indents = go - where - go = \case - [] -> "" - (caseName : cases) -> - indents - ++ caseName - ++ ",\n" - ++ go cases - -prettyEnumCases :: String -> String -> [(String, [(Maybe String, MoatType)])] -> String -prettyEnumCases typName indents = go - where - go = \case - [] -> "" - ((caseNm, []) : xs) -> - indents - ++ "object " - ++ toUpperFirst caseNm - ++ "() : " - ++ typName - ++ "\n" - ++ go xs - ((caseNm, cs) : xs) -> - indents - ++ "data class " - ++ toUpperFirst caseNm - ++ "(\n" - ++ intercalate - ",\n" - ( map - ( (indents ++) - . (++) indents - . uncurry labelCase - ) - cs - ) - ++ "\n" - ++ indents - ++ ")\n" - ++ go xs - -labelCase :: Maybe String -> MoatType -> String -labelCase Nothing ty = prettyMoatType ty -labelCase (Just label) ty = "val " ++ label ++ ": " ++ prettyMoatType ty - -prettyMoatTypeHeader :: String -> [String] -> String -prettyMoatTypeHeader name [] = name -prettyMoatTypeHeader name tyVars = name ++ "<" ++ intercalate ", " tyVars ++ ">" - -prettyAnnotations :: [Annotation] -> String -prettyAnnotations = concatMap (\ann -> "@" ++ prettyAnnotation ann ++ "\n") - where - prettyAnnotation :: Annotation -> String - prettyAnnotation = \case - Parcelize -> "Parcelize" - Serializable -> "Serializable" - RawAnnotation s -> s - -prettyInterfaces :: [Interface] -> String -prettyInterfaces [] = "" -prettyInterfaces ps = " : " ++ intercalate ", " (prettyInterface <$> ps) - where - prettyInterface :: Interface -> String - prettyInterface = \case - Parcelable -> "Parcelable" - RawInterface s -> s - LinkEnumInterface s -> s ++ "()" - --- | Pretty-print a 'Ty'. -prettyMoatType :: MoatType -> String -prettyMoatType = \case - Str -> "String" - Unit -> "()" - Bool -> "Boolean" - Character -> "Char" - Tuple2 e1 e2 -> "(" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ")" - Tuple3 e1 e2 e3 -> "(" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ", " ++ prettyMoatType e3 ++ ")" - Optional e -> prettyMoatType e ++ "?" - Result e1 e2 -> "Either<" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ">" - Set e -> "Set<" ++ prettyMoatType e ++ ">" - Dictionary e1 e2 -> "Map<" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ">" - Array e -> "List<" ++ prettyMoatType e ++ ">" - -- App is special, we recurse until we no longer - -- any applications. - App e1 e2 -> prettyApp e1 e2 - I -> "Int" - I8 -> "Byte" - I16 -> "Short" - I32 -> "Int" - I64 -> "Long" - U -> "UInt" - U8 -> "UByte" - U16 -> "UShort" - U32 -> "UInt" - U64 -> "ULong" - F32 -> "Float" - F64 -> "Double" - Decimal -> "Decimal" - BigInt -> "BigInteger" - Poly ty -> ty - Concrete ty [] -> ty - Concrete ty tys -> - ty - ++ "<" - ++ intercalate ", " (map prettyMoatType tys) - ++ ">" - Tag {..} -> tagName - -prettyApp :: MoatType -> MoatType -> String -prettyApp t1 t2 = - "((" - ++ intercalate ", " (map prettyMoatType as) - ++ ") -> " - ++ prettyMoatType r - ++ ")" - where - (as, r) = go t1 t2 - go e1 (App e2 e3) = case go e2 e3 of - (args, ret) -> (e1 : args, ret) - go e1 e2 = ([e1], e2) - -prettyEnum :: - () => - [Annotation] -> - -- | interfaces - [Interface] -> - -- | name - String -> - -- | ty vars - [String] -> - -- | cases - [(String, [(Maybe String, MoatType)])] -> - -- | indents - String -> - String -prettyEnum anns ifaces name tyVars cases indents - | isCEnum cases = - prettyAnnotations (dontAddSerializeToEnums anns) - ++ "enum class " - ++ prettyMoatTypeHeader name tyVars - ++ prettyInterfaces ifaces - ++ " {" - ++ newlineNonEmpty cases - ++ prettyCEnumCases indents (map fst cases) - ++ "}" - | allConcrete cases = - prettyAnnotations anns - ++ "sealed class " - ++ prettyMoatTypeHeader name tyVars - ++ prettyInterfaces ifaces - | otherwise = - prettyAnnotations (dontAddSerializeToEnums anns) - ++ "enum class " - ++ prettyMoatTypeHeader name tyVars - ++ prettyInterfaces ifaces - ++ " {" - ++ newlineNonEmpty cases - ++ prettyEnumCases name indents cases - ++ "}" - where - isCEnum :: Eq b => [(a, [b])] -> Bool - isCEnum = all ((== []) . snd) - - allConcrete :: [(a, [(b, MoatType)])] -> Bool - allConcrete inp = all isConcrete moatTypes - where - moatTypes = fmap snd (concatMap snd inp) - isConcrete Concrete {} = True - isConcrete _ = False - - -- because they get it automatically - dontAddSerializeToEnums :: [Annotation] -> [Annotation] - dontAddSerializeToEnums = filter (/= Serializable) - -newlineNonEmpty :: [a] -> String -newlineNonEmpty [] = "" -newlineNonEmpty _ = "\n" - -toUpperFirst :: String -> String -toUpperFirst = \case - [] -> [] - (c : cs) -> Char.toUpper c : cs +-- The 'TaggedObject' style will encode a sum of products where the parent sum has +-- a tag field and a contents field. +-- +-- The 'TaggedFlatObject' style will encode a sum of products where the parent sum +-- has only a tag field. +data EncodingStyle + = TaggedObjectStyle TaggedObject.TaggedObject + | TaggedFlatObjectStyle TaggedFlatObject.TaggedFlatObject + +prettyKotlinData :: EncodingStyle -> MoatData -> String +prettyKotlinData (TaggedObjectStyle to) = TaggedObject.prettyKotlinData to +prettyKotlinData (TaggedFlatObjectStyle tfo) = TaggedFlatObject.prettyKotlinData tfo diff --git a/src/Moat/Pretty/Kotlin/TaggedFlatObject.hs b/src/Moat/Pretty/Kotlin/TaggedFlatObject.hs new file mode 100644 index 0000000..5dd6d4e --- /dev/null +++ b/src/Moat/Pretty/Kotlin/TaggedFlatObject.hs @@ -0,0 +1,260 @@ +module Moat.Pretty.Kotlin.TaggedFlatObject + ( prettyKotlinData, + TaggedFlatObject (..), + ) +where + +import qualified Data.Char as Char +import Data.List (intercalate) +import Moat.Types + +newtype TaggedFlatObject = TaggedFlatObject + { tfoTagFieldName :: String + } + +-- | Convert a 'MoatData' into a canonical representation in Kotlin +-- +-- This is a decent default if you plan to do Android development, however you +-- could instead use this as a template to write your own version. Or, use it +-- to write an entirely new language backend :) +prettyKotlinData :: TaggedFlatObject -> MoatData -> String +prettyKotlinData TaggedFlatObject {} = \case + MoatStruct {..} -> + "" + ++ prettyAnnotations structAnnotations + ++ "data class " + ++ prettyMoatTypeHeader structName structTyVars + ++ "(" + ++ newlineNonEmpty structFields + ++ prettyStructFields indents structFields + ++ ")" + ++ prettyInterfaces structInterfaces + MoatEnum {..} -> + prettyEnum + enumAnnotations + enumInterfaces + enumName + enumTyVars + enumCases + indents + MoatNewtype {..} -> + "" + ++ prettyAnnotations newtypeAnnotations + ++ "inline class " + ++ prettyMoatTypeHeader newtypeName newtypeTyVars + ++ "(val " + ++ fst newtypeField + ++ ": " + ++ prettyMoatType (snd newtypeField) + ++ ")" + ++ prettyInterfaces newtypeInterfaces + MoatAlias {..} -> + "" + ++ "typealias " + ++ prettyMoatTypeHeader aliasName aliasTyVars + ++ " = " + ++ prettyMoatType aliasTyp + where + indent = 4 + indents = replicate indent ' ' + +prettyStructFields :: String -> [(String, MoatType)] -> String +prettyStructFields indents = go + where + go [] = "" + go ((fieldName, ty) : fs) = + indents + ++ "val " + ++ fieldName + ++ ": " + ++ prettyMoatType ty + ++ case ty of + Optional _ -> " = null" + _ -> "" + ++ ",\n" + ++ go fs + +prettyCEnumCases :: String -> [String] -> String +prettyCEnumCases indents = go + where + go = \case + [] -> "" + (caseName : cases) -> + indents + ++ caseName + ++ ",\n" + ++ go cases + +prettyEnumCases :: String -> String -> [(String, [(Maybe String, MoatType)])] -> String +prettyEnumCases typName indents = go + where + go = \case + [] -> "" + ((caseNm, []) : xs) -> + indents + ++ "object " + ++ toUpperFirst caseNm + ++ "() : " + ++ typName + ++ "\n" + ++ go xs + ((caseNm, cs) : xs) -> + indents + ++ "data class " + ++ toUpperFirst caseNm + ++ "(\n" + ++ intercalate + ",\n" + ( map + ( (indents ++) + . (++) indents + . uncurry labelCase + ) + cs + ) + ++ "\n" + ++ indents + ++ ")\n" + ++ go xs + +labelCase :: Maybe String -> MoatType -> String +labelCase Nothing ty = prettyMoatType ty +labelCase (Just label) ty = "val " ++ label ++ ": " ++ prettyMoatType ty + +prettyMoatTypeHeader :: String -> [String] -> String +prettyMoatTypeHeader name [] = name +prettyMoatTypeHeader name tyVars = name ++ "<" ++ intercalate ", " tyVars ++ ">" + +prettyAnnotations :: [Annotation] -> String +prettyAnnotations = concatMap (\ann -> "@" ++ prettyAnnotation ann ++ "\n") + where + prettyAnnotation :: Annotation -> String + prettyAnnotation = \case + Parcelize -> "Parcelize" + Serializable -> "Serializable" + RawAnnotation s -> s + +prettyInterfaces :: [Interface] -> String +prettyInterfaces [] = "" +prettyInterfaces ps = " : " ++ intercalate ", " (prettyInterface <$> ps) + where + prettyInterface :: Interface -> String + prettyInterface = \case + Parcelable -> "Parcelable" + RawInterface s -> s + LinkEnumInterface s -> s ++ "()" + +-- | Pretty-print a 'Ty'. +prettyMoatType :: MoatType -> String +prettyMoatType = \case + Str -> "String" + Unit -> "()" + Bool -> "Boolean" + Character -> "Char" + Tuple2 e1 e2 -> "(" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ")" + Tuple3 e1 e2 e3 -> "(" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ", " ++ prettyMoatType e3 ++ ")" + Optional e -> prettyMoatType e ++ "?" + Result e1 e2 -> "Either<" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ">" + Set e -> "Set<" ++ prettyMoatType e ++ ">" + Dictionary e1 e2 -> "Map<" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ">" + Array e -> "List<" ++ prettyMoatType e ++ ">" + -- App is special, we recurse until we no longer + -- any applications. + App e1 e2 -> prettyApp e1 e2 + I -> "Int" + I8 -> "Byte" + I16 -> "Short" + I32 -> "Int" + I64 -> "Long" + U -> "UInt" + U8 -> "UByte" + U16 -> "UShort" + U32 -> "UInt" + U64 -> "ULong" + F32 -> "Float" + F64 -> "Double" + Decimal -> "Decimal" + BigInt -> "BigInteger" + Poly ty -> ty + Concrete ty [] -> ty + Concrete ty tys -> + ty + ++ "<" + ++ intercalate ", " (map prettyMoatType tys) + ++ ">" + Tag {..} -> tagName + +prettyApp :: MoatType -> MoatType -> String +prettyApp t1 t2 = + "((" + ++ intercalate ", " (map prettyMoatType as) + ++ ") -> " + ++ prettyMoatType r + ++ ")" + where + (as, r) = go t1 t2 + go e1 (App e2 e3) = case go e2 e3 of + (args, ret) -> (e1 : args, ret) + go e1 e2 = ([e1], e2) + +prettyEnum :: + () => + [Annotation] -> + -- | interfaces + [Interface] -> + -- | name + String -> + -- | ty vars + [String] -> + -- | cases + [(String, [(Maybe String, MoatType)])] -> + -- | indents + String -> + String +prettyEnum anns ifaces name tyVars cases indents + | isCEnum cases = + prettyAnnotations (dontAddSerializeToEnums anns) + ++ "enum class " + ++ prettyMoatTypeHeader name tyVars + ++ prettyInterfaces ifaces + ++ " {" + ++ newlineNonEmpty cases + ++ prettyCEnumCases indents (map fst cases) + ++ "}" + | allConcrete cases = + prettyAnnotations anns + ++ "sealed class " + ++ prettyMoatTypeHeader name tyVars + ++ prettyInterfaces ifaces + | otherwise = + prettyAnnotations (dontAddSerializeToEnums anns) + ++ "enum class " + ++ prettyMoatTypeHeader name tyVars + ++ prettyInterfaces ifaces + ++ " {" + ++ newlineNonEmpty cases + ++ prettyEnumCases name indents cases + ++ "}" + where + isCEnum :: Eq b => [(a, [b])] -> Bool + isCEnum = all ((== []) . snd) + + allConcrete :: [(a, [(b, MoatType)])] -> Bool + allConcrete inp = all isConcrete moatTypes + where + moatTypes = fmap snd (concatMap snd inp) + isConcrete Concrete {} = True + isConcrete _ = False + + -- because they get it automatically + dontAddSerializeToEnums :: [Annotation] -> [Annotation] + dontAddSerializeToEnums = filter (/= Serializable) + +newlineNonEmpty :: [a] -> String +newlineNonEmpty [] = "" +newlineNonEmpty _ = "\n" + +toUpperFirst :: String -> String +toUpperFirst = \case + [] -> [] + (c : cs) -> Char.toUpper c : cs diff --git a/src/Moat/Pretty/Kotlin/TaggedObject.hs b/src/Moat/Pretty/Kotlin/TaggedObject.hs new file mode 100644 index 0000000..320acd0 --- /dev/null +++ b/src/Moat/Pretty/Kotlin/TaggedObject.hs @@ -0,0 +1,290 @@ +module Moat.Pretty.Kotlin.TaggedObject + ( prettyKotlinData, + TaggedObject (..), + ) +where + +import qualified Data.Char as Char +import Data.Functor ((<&>)) +import Data.List (intercalate) +import Moat.Types + +data TaggedObject = TaggedObject + { tagFieldName :: String, + contentsFieldName :: String + } + +-- | Convert a 'MoatData' into a canonical representation in Kotlin +-- +-- This is a decent default if you plan to do Android development, however you +-- could instead use this as a template to write your own version. Or, use it +-- to write an entirely new language backend :) +prettyKotlinData :: TaggedObject -> MoatData -> String +prettyKotlinData tags = \case + MoatStruct {..} -> + prettyAnnotations noIndent structAnnotations + ++ "data class " + ++ prettyMoatTypeHeader structName structTyVars + ++ "(" + ++ newlineNonEmpty structFields + ++ prettyStructFields indents structFields + ++ ")" + ++ prettyInterfaces structInterfaces + MoatEnum {..} -> + prettyEnum + enumAnnotations + enumInterfaces + enumName + enumTyVars + enumCases + indents + tags + MoatNewtype {..} -> + "" + ++ prettyAnnotations indents newtypeAnnotations + ++ "inline class " + ++ prettyMoatTypeHeader newtypeName newtypeTyVars + ++ "(val " + ++ fst newtypeField + ++ ": " + ++ prettyMoatType (snd newtypeField) + ++ ")" + ++ prettyInterfaces newtypeInterfaces + MoatAlias {..} -> + "" + ++ "typealias " + ++ prettyMoatTypeHeader aliasName aliasTyVars + ++ " = " + ++ prettyMoatType aliasTyp + where + indent = 4 + indents = replicate indent ' ' + +prettyStructFields :: String -> [(String, MoatType)] -> String +prettyStructFields indents = go + where + go [] = "" + go ((fieldName, ty) : fs) = + indents + ++ "val " + ++ fieldName + ++ ": " + ++ prettyMoatType ty + ++ case ty of + Optional _ -> " = null" + _ -> "" + ++ ",\n" + ++ go fs + +prettyCEnumCases :: String -> [String] -> String +prettyCEnumCases indents = go + where + go = \case + [] -> "" + (caseName : cases) -> + indents + ++ caseName + ++ ",\n" + ++ go cases + +prettyEnumCases :: String -> String -> [(String, [(Maybe String, MoatType)])] -> String +prettyEnumCases typName indents = go + where + go = \case + [] -> "" + ((caseNm, []) : xs) -> + indents + ++ "object " + ++ toUpperFirst caseNm + ++ "() : " + ++ typName + ++ "\n" + ++ go xs + ((caseNm, cs) : xs) -> + indents + ++ "data class " + ++ toUpperFirst caseNm + ++ "(\n" + ++ intercalate + ",\n" + ( map + ( (indents ++) + . (++) indents + . uncurry labelCase + ) + cs + ) + ++ "\n" + ++ indents + ++ ")\n" + ++ go xs + +labelCase :: Maybe String -> MoatType -> String +labelCase Nothing ty = prettyMoatType ty +labelCase (Just label) ty = "val " ++ label ++ ": " ++ prettyMoatType ty + +prettyMoatTypeHeader :: String -> [String] -> String +prettyMoatTypeHeader name [] = name +prettyMoatTypeHeader name tyVars = name ++ "<" ++ intercalate ", " tyVars ++ ">" + +prettyAnnotations :: String -> [Annotation] -> String +prettyAnnotations indents = concatMap (\ann -> indents <> "@" <> prettyAnnotation ann <> "\n") + where + prettyAnnotation :: Annotation -> String + prettyAnnotation = \case + Parcelize -> "Parcelize" + Serializable -> "Serializable" + RawAnnotation s -> s + +prettyInterfaces :: [Interface] -> String +prettyInterfaces [] = "" +prettyInterfaces ps = " : " ++ intercalate ", " (prettyInterface <$> ps) + where + prettyInterface :: Interface -> String + prettyInterface = \case + Parcelable -> "Parcelable" + RawInterface s -> s + LinkEnumInterface s -> s ++ "()" + +-- | Pretty-print a 'Ty'. +prettyMoatType :: MoatType -> String +prettyMoatType = \case + Str -> "String" + Unit -> "()" + Bool -> "Boolean" + Character -> "Char" + Tuple2 e1 e2 -> "(" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ")" + Tuple3 e1 e2 e3 -> "(" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ", " ++ prettyMoatType e3 ++ ")" + Optional e -> prettyMoatType e ++ "?" + Result e1 e2 -> "Either<" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ">" + Set e -> "Set<" ++ prettyMoatType e ++ ">" + Dictionary e1 e2 -> "Map<" ++ prettyMoatType e1 ++ ", " ++ prettyMoatType e2 ++ ">" + Array e -> "List<" ++ prettyMoatType e ++ ">" + -- App is special, we recurse until we no longer + -- any applications. + App e1 e2 -> prettyApp e1 e2 + I -> "Int" + I8 -> "Byte" + I16 -> "Short" + I32 -> "Int" + I64 -> "Long" + U -> "UInt" + U8 -> "UByte" + U16 -> "UShort" + U32 -> "UInt" + U64 -> "ULong" + F32 -> "Float" + F64 -> "Double" + Decimal -> "Decimal" + BigInt -> "BigInteger" + Poly ty -> ty + Concrete ty [] -> ty + Concrete ty tys -> + ty + ++ "<" + ++ intercalate ", " (map prettyMoatType tys) + ++ ">" + Tag {..} -> tagName + +prettyApp :: MoatType -> MoatType -> String +prettyApp t1 t2 = + "((" + ++ intercalate ", " (map prettyMoatType as) + ++ ") -> " + ++ prettyMoatType r + ++ ")" + where + (as, r) = go t1 t2 + go e1 (App e2 e3) = case go e2 e3 of + (args, ret) -> (e1 : args, ret) + go e1 e2 = ([e1], e2) + +prettySumOfProduct_Sum :: String -> [Annotation] -> [(String, [(Maybe String, MoatType)])] -> String -> TaggedObject -> String +prettySumOfProduct_Sum parentName anns cases indents TaggedObject {..} = + intercalate + "\n\n" + ( cases <&> \(caseNm, [(_, Concrete {concreteName = concreteName})]) -> + prettyAnnotations indents (anns ++ [RawAnnotation $ "SerialName(\"" <> caseNm <> "\")"]) + ++ indents + ++ "data class " + ++ toUpperFirst caseNm + ++ "(val " + ++ contentsFieldName + ++ ": " + ++ concreteName + ++ ") : " + ++ parentName + ++ "()" + ) + +prettyEnum :: + () => + [Annotation] -> + -- | interfaces + [Interface] -> + -- | name + String -> + -- | ty vars + [String] -> + -- | cases + [(String, [(Maybe String, MoatType)])] -> + -- | indents + String -> + -- | tags + TaggedObject -> + String +prettyEnum anns ifaces name tyVars cases indents to@TaggedObject {..} + | isCEnum cases = + prettyAnnotations indents (dontAddSerializeToEnums anns) + ++ "enum class " + ++ prettyMoatTypeHeader name tyVars + ++ prettyInterfaces ifaces + ++ " {" + ++ newlineNonEmpty cases + ++ prettyCEnumCases indents (map fst cases) + ++ "}" + | allConcrete cases = + prettyAnnotations + noIndent + [RawAnnotation ("JsonClassDiscriminator(\"" <> tagFieldName <> "\")")] + ++ "sealed class " + ++ prettyMoatTypeHeader name tyVars + ++ prettyInterfaces ifaces + ++ " {\n" + ++ prettySumOfProduct_Sum name anns cases indents to + ++ "\n}" + | otherwise = + prettyAnnotations indents (dontAddSerializeToEnums anns) + ++ "enum class " + ++ prettyMoatTypeHeader name tyVars + ++ prettyInterfaces ifaces + ++ " {" + ++ newlineNonEmpty cases + ++ prettyEnumCases name indents cases + ++ "}" + where + isCEnum :: Eq b => [(a, [b])] -> Bool + isCEnum = all ((== []) . snd) + + allConcrete :: [(a, [(b, MoatType)])] -> Bool + allConcrete inp = all isConcrete moatTypes + where + moatTypes = fmap snd (concatMap snd inp) + isConcrete Concrete {} = True + isConcrete _ = False + + -- because they get it automatically + dontAddSerializeToEnums :: [Annotation] -> [Annotation] + dontAddSerializeToEnums = filter (/= Serializable) + +newlineNonEmpty :: [a] -> String +newlineNonEmpty [] = "" +newlineNonEmpty _ = "\n" + +toUpperFirst :: String -> String +toUpperFirst = \case + [] -> [] + (c : cs) -> Char.toUpper c : cs + +noIndent :: String +noIndent = "" diff --git a/test/AdvancedEnumSpec.hs b/test/AdvancedEnumSpec.hs index 0402ef5..1e0fb23 100644 --- a/test/AdvancedEnumSpec.hs +++ b/test/AdvancedEnumSpec.hs @@ -27,4 +27,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Enum) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Enum) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Enum) diff --git a/test/AdvancedEnumWithRawValueSpec.hs b/test/AdvancedEnumWithRawValueSpec.hs index a8764a0..4873309 100644 --- a/test/AdvancedEnumWithRawValueSpec.hs +++ b/test/AdvancedEnumWithRawValueSpec.hs @@ -27,4 +27,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Enum) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Enum) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Enum) diff --git a/test/AdvancedNewtypeSpec.hs b/test/AdvancedNewtypeSpec.hs index b51ac9e..f3f4038 100644 --- a/test/AdvancedNewtypeSpec.hs +++ b/test/AdvancedNewtypeSpec.hs @@ -25,4 +25,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Newtype) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Newtype) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Newtype) diff --git a/test/AdvancedNewtypeWithEnumFieldSpec.hs b/test/AdvancedNewtypeWithEnumFieldSpec.hs index 724dbde..95f0ec6 100644 --- a/test/AdvancedNewtypeWithEnumFieldSpec.hs +++ b/test/AdvancedNewtypeWithEnumFieldSpec.hs @@ -24,4 +24,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Newtype) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Newtype) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Newtype) diff --git a/test/AdvancedRecordSpec.hs b/test/AdvancedRecordSpec.hs index 3f3234e..3d75219 100644 --- a/test/AdvancedRecordSpec.hs +++ b/test/AdvancedRecordSpec.hs @@ -26,4 +26,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Data) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Data) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Data) diff --git a/test/BasicEnumSpec.hs b/test/BasicEnumSpec.hs index fade87a..1ce0022 100644 --- a/test/BasicEnumSpec.hs +++ b/test/BasicEnumSpec.hs @@ -21,4 +21,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Enum) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Enum) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Enum) diff --git a/test/BasicEnumWithRawValueSpec.hs b/test/BasicEnumWithRawValueSpec.hs index 7551df1..699f0fa 100644 --- a/test/BasicEnumWithRawValueSpec.hs +++ b/test/BasicEnumWithRawValueSpec.hs @@ -20,4 +20,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Enum) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Enum) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Enum) diff --git a/test/BasicNewtypeSpec.hs b/test/BasicNewtypeSpec.hs index b7a1196..f453cdc 100644 --- a/test/BasicNewtypeSpec.hs +++ b/test/BasicNewtypeSpec.hs @@ -19,4 +19,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Newtype) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Newtype) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Newtype) diff --git a/test/BasicNewtypeWithConcreteFieldSpec.hs b/test/BasicNewtypeWithConcreteFieldSpec.hs index 1ebc9ad..8ee1805 100644 --- a/test/BasicNewtypeWithConcreteFieldSpec.hs +++ b/test/BasicNewtypeWithConcreteFieldSpec.hs @@ -18,4 +18,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Newtype) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Newtype) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Newtype) diff --git a/test/BasicNewtypeWithEitherFieldSpec.hs b/test/BasicNewtypeWithEitherFieldSpec.hs index 7cdf983..c7e96a7 100644 --- a/test/BasicNewtypeWithEitherFieldSpec.hs +++ b/test/BasicNewtypeWithEitherFieldSpec.hs @@ -17,4 +17,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Newtype) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Newtype) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Newtype) diff --git a/test/BasicRecordSpec.hs b/test/BasicRecordSpec.hs index 0f1a2e2..8cd2670 100644 --- a/test/BasicRecordSpec.hs +++ b/test/BasicRecordSpec.hs @@ -20,4 +20,4 @@ spec = it "swift" $ defaultGolden ("swift" <> moduleName) (showSwift @Data) it "kotlin" $ - defaultGolden ("kotlin" <> moduleName) (showKotlin @Data) + defaultGolden ("kotlin-tagged-flat-object-" <> moduleName) (showKotlinTaggedFlatObject @Data) diff --git a/test/Common.hs b/test/Common.hs index eee4e4b..a175a83 100644 --- a/test/Common.hs +++ b/test/Common.hs @@ -3,8 +3,17 @@ module Common where import Data.Proxy (Proxy (..)) import Moat -showKotlin :: forall a. ToMoatData a => String -showKotlin = prettyKotlinData $ toMoatData (Proxy @a) +showKotlinTaggedObject :: forall a. ToMoatData a => String +showKotlinTaggedObject = + prettyKotlinData + (TaggedObjectStyle $ TaggedObject "tag" "contents") + (toMoatData $ Proxy @a) + +showKotlinTaggedFlatObject :: forall a. ToMoatData a => String +showKotlinTaggedFlatObject = + prettyKotlinData + (TaggedFlatObjectStyle $ TaggedFlatObject "tag") + (toMoatData $ Proxy @a) showSwift :: forall a. ToMoatData a => String showSwift = prettySwiftData $ toMoatData (Proxy @a) diff --git a/test/SumOfProductSpec.hs b/test/SumOfProductSpec.hs index 3ce12d6..9994687 100644 --- a/test/SumOfProductSpec.hs +++ b/test/SumOfProductSpec.hs @@ -27,4 +27,4 @@ spec = it "swift" $ defaultGolden ("swiftEnum" <> moduleName) (showSwift @Enum) it "kotlin" $ - defaultGolden ("kotlinEnum" <> moduleName) (showKotlin @Enum) + defaultGolden ("kotlin-tagged-flat-object-Enum" <> moduleName) (showKotlinTaggedFlatObject @Enum) diff --git a/test/SumOfProductWithLinkEnumInterfaceSpec.hs b/test/SumOfProductWithLinkEnumInterfaceSpec.hs index e06dd4c..2eba832 100644 --- a/test/SumOfProductWithLinkEnumInterfaceSpec.hs +++ b/test/SumOfProductWithLinkEnumInterfaceSpec.hs @@ -14,7 +14,7 @@ data Record0 = Record0 mobileGenWith ( defaultOptions { dataAnnotations = [Parcelize, Serializable], - dataInterfaces = [LinkEnumInterface "Enum"], + dataInterfaces = [Parcelable], dataProtocols = [OtherProtocol "CaseIterable", Hashable, Codable] } ) @@ -28,7 +28,7 @@ data Record1 = Record1 mobileGenWith ( defaultOptions { dataAnnotations = [Parcelize, Serializable], - dataInterfaces = [LinkEnumInterface "Enum"], + dataInterfaces = [Parcelable], dataProtocols = [OtherProtocol "CaseIterable", Hashable, Codable] } ) @@ -40,7 +40,7 @@ data Enum mobileGenWith ( defaultOptions - { dataAnnotations = [RawAnnotation "Serializable(with = Enum1Serializer::class)"], + { dataAnnotations = [Parcelize, Serializable], dataInterfaces = [Parcelable], dataProtocols = [OtherProtocol "CaseIterable", Hashable, Codable] } @@ -58,8 +58,14 @@ spec = it "swift" $ defaultGolden ("swiftEnum" <> moduleName) (showSwift @Enum) it "kotlin" $ - defaultGolden ("kotlinRecord0" <> moduleName) (showKotlin @Record0) + defaultGolden ("kotlin-tagged-object-Record0" <> moduleName) (showKotlinTaggedObject @Record0) + it "kotlin" $ + defaultGolden ("kotlin-tagged-flat-object-Record0" <> moduleName) (showKotlinTaggedFlatObject @Record0) + it "kotlin" $ + defaultGolden ("kotlin-tagged-object-Record1" <> moduleName) (showKotlinTaggedObject @Record1) + it "kotlin" $ + defaultGolden ("kotlin-tagged-flat-object-Record1" <> moduleName) (showKotlinTaggedFlatObject @Record1) it "kotlin" $ - defaultGolden ("kotlinRecord1" <> moduleName) (showKotlin @Record1) + defaultGolden ("kotlin-tagged-object-Enum" <> moduleName) (showKotlinTaggedObject @Enum) it "kotlin" $ - defaultGolden ("kotlinEnum" <> moduleName) (showKotlin @Enum) + defaultGolden ("kotlin-tagged-flat-object-Enum" <> moduleName) (showKotlinTaggedFlatObject @Enum)