Merge pull request #76 from MercuryTechnologies/tad/generic-sum-types

Fix codegen for sum-of-products with generic parameters

Author: tadfisher

.golden/kotlinSumOfProductWithTypeParameterSpec/golden

@@ -0,0 +1,11 @@
+@JsonClassDiscriminator("direction")
+@Serializable
+sealed class CursorInput<A> {
+    @Serializable
+    @SerialName("nextPage")
+    data class NextPage<A>(val key: A?) : CursorInput<A>()
+
+    @Serializable
+    @SerialName("previousPage")
+    data class PreviousPage<A>(val key: A) : CursorInput<A>()
+}

.golden/swiftSumOfProductWithTypeParameterSpec/golden

@@ -0,0 +1,4 @@
+enum CursorInput<A: Hashable & Codable>: CaseIterable, Hashable, Codable {
+    case nextPage(A?)
+    case previousPage(A)
+}

moat.cabal

@@ -94,6 +94,7 @@ test-suite spec
       SumOfProductWithTaggedObjectAndNonConcreteCasesSpec
       SumOfProductWithTaggedObjectAndSingleNullarySpec
       SumOfProductWithTaggedObjectStyleSpec
+      SumOfProductWithTypeParameterSpec
       TypeVariableSpec
       Moat
       Moat.Class

src/Moat/Pretty/Kotlin.hs

@@ -224,12 +224,14 @@ prettyApp t1 t2 =
 -- error is restricted
 prettyTaggedObject ::
   String ->
+  [String] ->
   [Annotation] ->
+  [Interface] ->
   [EnumCase] ->
   String ->
   SumOfProductEncodingOptions ->
   String
-prettyTaggedObject parentName anns cases indents SumOfProductEncodingOptions {..} =
+prettyTaggedObject parentName tyVars anns ifaces cases indents SumOfProductEncodingOptions {..} =
   intercalate
     "\n\n"
     ( cases <&> \case
@@ -238,29 +240,35 @@ prettyTaggedObject parentName anns cases indents SumOfProductEncodingOptions {..
             ++ prettyAnnotations (Just caseNm) indents anns
             ++ indents
             ++ "data class "
-            ++ toUpperFirst caseNm
+            ++ caseTypeHeader caseNm
             ++ "(val "
             ++ contentsFieldName
             ++ ": "
             ++ prettyMoatType caseTy
             ++ ") : "
-            ++ parentName
+            ++ parentTypeHeader
             ++ "()"
         EnumCase caseNm caseDoc [] ->
           prettyTypeDoc indents caseDoc []
             ++ prettyAnnotations (Just caseNm) indents anns
             ++ indents
             ++ "data object "
-            ++ toUpperFirst caseNm
+            ++ caseTypeHeader caseNm
             ++ " : "
-            ++ parentName
+            ++ parentTypeHeader
             ++ "()"
         EnumCase caseNm _ _ ->
           error $
             "prettyTaggedObject: The data constructor "
               <> caseNm
               <> " can have zero or one concrete type constructor!"
     )
+  where
+    caseTypeHeader :: String -> String
+    caseTypeHeader name = prettyMoatTypeHeader (toUpperFirst name) (addTyVarBounds tyVars ifaces)
+
+    parentTypeHeader :: String
+    parentTypeHeader = prettyMoatTypeHeader parentName tyVars
 
 prettyEnum ::
   () =>
@@ -325,7 +333,7 @@ prettyEnum doc anns ifaces name tyVars cases sop@SumOfProductEncodingOptions {..
             ++ classTyp
             ++ prettyInterfaces ifaces
             ++ " {\n"
-            ++ prettyTaggedObject name anns cases indents sop
+            ++ prettyTaggedObject name tyVars anns ifaces cases indents sop
             ++ "\n}"
   where
     isCEnum :: [EnumCase] -> Bool

test/SumOfProductWithTypeParameterSpec.hs

@@ -0,0 +1,38 @@
+module SumOfProductWithTypeParameterSpec where
+
+import Common
+import Data.List (stripPrefix)
+import Data.Maybe
+import Moat
+import Test.Hspec
+import Test.Hspec.Golden
+import Prelude hiding (Enum)
+
+data CursorInput a
+  = CursorInputNextPage (Maybe a)
+  | CursorInputPreviousPage a
+
+mobileGenWith
+  ( defaultOptions
+      { constructorModifier = \body -> fromMaybe body (stripPrefix "CursorInput" body)
+      , dataAnnotations = [Serializable, SerialName]
+      , dataProtocols = [OtherProtocol "CaseIterable", Hashable, Codable]
+      , sumOfProductEncodingOptions =
+          SumOfProductEncodingOptions
+            { encodingStyle = TaggedObjectStyle
+            , sumAnnotations = [RawAnnotation "JsonClassDiscriminator(\"direction\")"]
+            , contentsFieldName = "key"
+            , tagFieldName = "direction"
+            }
+      }
+  )
+  ''CursorInput
+
+spec :: Spec
+spec =
+  describe "stays golden" $ do
+    let moduleName = "SumOfProductWithTypeParameterSpec"
+    it "kotlin" $
+      defaultGolden ("kotlin" <> moduleName) (showKotlin @(CursorInput _))
+    it "swift" $
+      defaultGolden ("swift" <> moduleName) (showSwift @(CursorInput _))