Allow configuration of Kotlin render style

.golden/kotlin-tagged-flat-object-EnumSumOfProductWithLinkEnumInterfaceSpec/golden

@@ -0,0 +1,3 @@
+@Parcelize
+@Serializable
+sealed class Enum : Parcelable

.golden/kotlinRecord0SumOfProductWithLinkEnumInterfaceSpec/golden → .golden/kotlin-tagged-flat-object-Record0SumOfProductWithLinkEnumInterfaceSpec/golden

@@ -3,4 +3,4 @@
 data class Record0(
     val record0Field0: Int,
     val record0Field1: Int,
-) : Enum()
+) : Parcelable

.golden/kotlinRecord1SumOfProductWithLinkEnumInterfaceSpec/golden → .golden/kotlin-tagged-flat-object-Record1SumOfProductWithLinkEnumInterfaceSpec/golden

@@ -3,4 +3,4 @@
 data class Record1(
     val record1Field0: Int,
     val record1Field1: Int,
-) : Enum()
+) : Parcelable

.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()
+}

.golden/kotlin-tagged-object-Record0SumOfProductWithLinkEnumInterfaceSpec/golden

@@ -0,0 +1,6 @@
+@Parcelize
+@Serializable
+data class Record0(
+    val record0Field0: Int,
+    val record0Field1: Int,
+) : Parcelable

.golden/kotlin-tagged-object-Record1SumOfProductWithLinkEnumInterfaceSpec/golden

@@ -0,0 +1,6 @@
+@Parcelize
+@Serializable
+data class Record1(
+    val record1Field0: Int,
+    val record1Field1: Int,
+) : Parcelable

flake.nix

@@ -78,6 +78,7 @@
               hpack
               ormolu
               hlint
+              haskell-language-server
             ];
           }
       );

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

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

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