Skip to content

Commit

Permalink
Merge pull request #76 from MercuryTechnologies/tad/generic-sum-types
Browse files Browse the repository at this point in the history
Fix codegen for sum-of-products with generic parameters
  • Loading branch information
tadfisher authored Feb 2, 2024
2 parents 4d5d79b + d2a88d7 commit a37fe36
Show file tree
Hide file tree
Showing 5 changed files with 68 additions and 6 deletions.
11 changes: 11 additions & 0 deletions .golden/kotlinSumOfProductWithTypeParameterSpec/golden
Original file line number Diff line number Diff line change
@@ -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>()
}
4 changes: 4 additions & 0 deletions .golden/swiftSumOfProductWithTypeParameterSpec/golden
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
enum CursorInput<A: Hashable & Codable>: CaseIterable, Hashable, Codable {
case nextPage(A?)
case previousPage(A)
}
1 change: 1 addition & 0 deletions moat.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -94,6 +94,7 @@ test-suite spec
SumOfProductWithTaggedObjectAndNonConcreteCasesSpec
SumOfProductWithTaggedObjectAndSingleNullarySpec
SumOfProductWithTaggedObjectStyleSpec
SumOfProductWithTypeParameterSpec
TypeVariableSpec
Moat
Moat.Class
Expand Down
20 changes: 14 additions & 6 deletions src/Moat/Pretty/Kotlin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ::
() =>
Expand Down Expand Up @@ -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
Expand Down
38 changes: 38 additions & 0 deletions test/SumOfProductWithTypeParameterSpec.hs
Original file line number Diff line number Diff line change
@@ -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 _))

0 comments on commit a37fe36

Please sign in to comment.