From eb5d1fcbfe202b21ede1573ddb6d431563127289 Mon Sep 17 00:00:00 2001 From: Barry Date: Mon, 15 Nov 2021 13:18:31 -0500 Subject: [PATCH 01/13] Add option and failing test --- .../golden | 14 ++++ .../golden | 6 ++ .../golden | 6 ++ moat.cabal | 1 + src/Moat.hs | 3 + src/Moat/Types.hs | 64 ++++++++++++++++++- test/SumOfProductWithTaggedObjectStyleSpec.hs | 59 +++++++++++++++++ 7 files changed, 151 insertions(+), 2 deletions(-) create mode 100644 .golden/kotlinEnumSumOfProductWithTaggedObjectStyleSpec/golden create mode 100644 .golden/kotlinRecord0SumOfProductWithTaggedObjectStyleSpec/golden create mode 100644 .golden/kotlinRecord1SumOfProductWithTaggedObjectStyleSpec/golden create mode 100644 test/SumOfProductWithTaggedObjectStyleSpec.hs diff --git a/.golden/kotlinEnumSumOfProductWithTaggedObjectStyleSpec/golden b/.golden/kotlinEnumSumOfProductWithTaggedObjectStyleSpec/golden new file mode 100644 index 0000000..cf77d55 --- /dev/null +++ b/.golden/kotlinEnumSumOfProductWithTaggedObjectStyleSpec/golden @@ -0,0 +1,14 @@ +@Parcelize +@Serializable +@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/kotlinRecord0SumOfProductWithTaggedObjectStyleSpec/golden b/.golden/kotlinRecord0SumOfProductWithTaggedObjectStyleSpec/golden new file mode 100644 index 0000000..19c6cfc --- /dev/null +++ b/.golden/kotlinRecord0SumOfProductWithTaggedObjectStyleSpec/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/kotlinRecord1SumOfProductWithTaggedObjectStyleSpec/golden b/.golden/kotlinRecord1SumOfProductWithTaggedObjectStyleSpec/golden new file mode 100644 index 0000000..e1201f1 --- /dev/null +++ b/.golden/kotlinRecord1SumOfProductWithTaggedObjectStyleSpec/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/moat.cabal b/moat.cabal index 7c2ac00..0ecd988 100644 --- a/moat.cabal +++ b/moat.cabal @@ -70,6 +70,7 @@ test-suite spec Common SumOfProductSpec SumOfProductWithLinkEnumInterfaceSpec + SumOfProductWithTaggedObjectStyleSpec Moat Moat.Class Moat.Pretty.Kotlin diff --git a/src/Moat.hs b/src/Moat.hs index ba128ea..2451087 100644 --- a/src/Moat.hs +++ b/src/Moat.hs @@ -44,6 +44,8 @@ module Moat -- ** Option type and defaults Options, defaultOptions, + defaultTaggedObjectEncodingStyle, + defaultTaggedFlatObjectEncodingStyle, -- ** Helper type for omissions KeepOrDiscard (..), @@ -64,6 +66,7 @@ module Moat omitFields, omitCases, makeBase, + kotlinRenderingStyle, -- * Pretty-printing diff --git a/src/Moat/Types.hs b/src/Moat/Types.hs index 3976ffc..b82d616 100644 --- a/src/Moat/Types.hs +++ b/src/Moat/Types.hs @@ -7,12 +7,17 @@ module Moat.Types ( MoatType (..), MoatData (..), Backend (..), + EncodingStyle (..), + TaggedObject (..), + TaggedFlatObject (..), Protocol (..), Interface (..), Options (..), KeepOrDiscard (..), Annotation (..), defaultOptions, + defaultTaggedObjectEncodingStyle, + defaultTaggedFlatObjectEncodingStyle, ) where @@ -388,9 +393,61 @@ data Options = Options -- "Optional\". The default value ('False') -- will keep it as sugar. A value of 'True' -- will expand it to be desugared. - optionalExpand :: Bool + optionalExpand :: Bool, + -- | The encoding style for sum of products in Kotlin, + -- see 'TaggedObject' and 'TaggedFlatObject' for details + kotlinRenderingStyle :: EncodingStyle } +-- 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 + | TaggedFlatObjectStyle TaggedFlatObject + +-- | The contents of a tagged object are inside of the 'contentsFieldName', e.g. +-- +-- @ +-- { +-- "tag": ..., +-- "contents": ... +-- } +-- @ +data TaggedObject = TaggedObject + { tagFieldName :: String, + contentsFieldName :: String + } + +defaultTaggedObjectEncodingStyle :: EncodingStyle +defaultTaggedObjectEncodingStyle = + TaggedObjectStyle $ + TaggedObject + { tagFieldName = "tag", + contentsFieldName = "contents" + } + +-- | The contents of a tagged flat object are at the same level as the tag, e.g. +-- +-- @ +-- { +-- "tag": ..., +-- ... +-- } +-- @ +newtype TaggedFlatObject = TaggedFlatObject + { taggedFlatObjectTagFieldName :: String + } + +defaultTaggedFlatObjectEncodingStyle :: EncodingStyle +defaultTaggedFlatObjectEncodingStyle = + TaggedFlatObjectStyle $ + TaggedFlatObject + { taggedFlatObjectTagFieldName = "tag" + } + -- | The default 'Options'. -- -- @ @@ -413,6 +470,7 @@ data Options = Options -- , omitCases = const Keep -- , makeBase = (False, Nothing, []) -- , optionalExpand = False +-- , kotlinRenderingStyle = defaultTaggedFlatObjectEncodingStyle -- } -- @ defaultOptions :: Options @@ -434,7 +492,9 @@ defaultOptions = omitFields = const Keep, omitCases = const Keep, makeBase = (False, Nothing, []), - optionalExpand = False + optionalExpand = False, + -- TODO: we should split backend configuration into their own ADTs + kotlinRenderingStyle = defaultTaggedFlatObjectEncodingStyle } data KeepOrDiscard = Keep | Discard diff --git a/test/SumOfProductWithTaggedObjectStyleSpec.hs b/test/SumOfProductWithTaggedObjectStyleSpec.hs new file mode 100644 index 0000000..b053353 --- /dev/null +++ b/test/SumOfProductWithTaggedObjectStyleSpec.hs @@ -0,0 +1,59 @@ +module SumOfProductWithTaggedObjectStyleSpec where + +import Common +import Moat +import Test.Hspec +import Test.Hspec.Golden +import Prelude hiding (Enum) + +data Record0 = Record0 + { record0Field0 :: Int, + record0Field1 :: Int + } + +mobileGenWith + ( defaultOptions + { dataAnnotations = [Parcelize, Serializable], + dataInterfaces = [Parcelable], + kotlinRenderingStyle = defaultTaggedObjectEncodingStyle + } + ) + ''Record0 + +data Record1 = Record1 + { record1Field0 :: Int, + record1Field1 :: Int + } + +mobileGenWith + ( defaultOptions + { dataAnnotations = [Parcelize, Serializable], + dataInterfaces = [Parcelable], + kotlinRenderingStyle = defaultTaggedObjectEncodingStyle + } + ) + ''Record1 + +data Enum + = DataCons0 Record0 + | DataCons1 Record1 + +mobileGenWith + ( defaultOptions + { dataAnnotations = [Parcelize, Serializable], + dataInterfaces = [Parcelable], + kotlinRenderingStyle = defaultTaggedObjectEncodingStyle + } + ) + ''Enum + +spec :: Spec +spec = + describe "stays golden" $ do + let moduleName = "SumOfProductWithTaggedObjectStyleSpec" + it "kotlin" $ + defaultGolden ("kotlinRecord0" <> moduleName) (showKotlin @Record0) + it "kotlin" $ + defaultGolden ("kotlinRecord1" <> moduleName) (showKotlin @Record1) + it "kotlin" $ + defaultGolden ("kotlinEnum" <> moduleName) (showKotlin @Enum) From b6976c410360af5d1e2d61ca0d698dd844ea0b5b Mon Sep 17 00:00:00 2001 From: Barry Date: Mon, 15 Nov 2021 13:51:20 -0500 Subject: [PATCH 02/13] Push encoding style into MoatEnum --- src/Moat.hs | 21 ++++++++++++------- src/Moat/Pretty/Kotlin.hs | 5 ++++- src/Moat/Types.hs | 11 +++++++--- test/SumOfProductWithTaggedObjectStyleSpec.hs | 6 +++--- 4 files changed, 28 insertions(+), 15 deletions(-) diff --git a/src/Moat.hs b/src/Moat.hs index 2451087..d5d6bd8 100644 --- a/src/Moat.hs +++ b/src/Moat.hs @@ -66,7 +66,7 @@ module Moat omitFields, omitCases, makeBase, - kotlinRenderingStyle, + encodingStyle, -- * Pretty-printing @@ -665,7 +665,7 @@ consToMoatType :: consToMoatType o@Options {..} parentName instTys variant ts bs = \case [] -> do value <- lift $ newName "value" - matches <- liftCons (mkVoid parentName instTys ts) + matches <- liftCons (mkVoid o parentName instTys ts) lift $ lamE [varP value] (caseE (varE value) matches) cons -> do -- TODO: use '_' instead of matching @@ -698,7 +698,7 @@ consToMoatType o@Options {..} parentName instTys variant ts bs = \case cases <- forM cons' (liftEither . mkCase o) ourMatch <- matchProxy - =<< lift (enumExp parentName instTys dataInterfaces dataProtocols dataAnnotations cases dataRawValue ts bs) + =<< lift (enumExp parentName instTys dataInterfaces dataProtocols dataAnnotations cases dataRawValue ts bs encodingStyle) pure [pure ourMatch] liftCons :: (Functor f, Applicative g) => f a -> f [g a] @@ -834,7 +834,7 @@ mkTypeTag Options {..} typName instTys = \case mkName (nameStr typName ++ "Tag") let tag = tagExp typName parentName field False - matchProxy =<< lift (enumExp parentName instTys dataInterfaces dataProtocols dataAnnotations [] dataRawValue [tag] (False, Nothing, [])) + matchProxy =<< lift (enumExp parentName instTys dataInterfaces dataProtocols dataAnnotations [] dataRawValue [tag] (False, Nothing, []) encodingStyle) _ -> throwError $ NotANewtype typName -- make a newtype into a type alias @@ -863,6 +863,7 @@ mkTypeAlias typName instTys = \case -- | Make a void type (empty enum) mkVoid :: () => + Options -> -- | type name Name -> -- | type variables @@ -870,9 +871,9 @@ mkVoid :: -- | tags [Exp] -> MoatM Match -mkVoid typName instTys ts = +mkVoid Options {..} typName instTys ts = matchProxy - =<< lift (enumExp typName instTys [] [] [] [] Nothing ts (False, Nothing, [])) + =<< lift (enumExp typName instTys [] [] [] [] Nothing ts (False, Nothing, []) encodingStyle) mkNewtype :: () => @@ -1465,12 +1466,15 @@ enumExp :: [Exp] -> -- | Make base? (Bool, Maybe MoatType, [Protocol]) -> + -- | EncodingStyle + EncodingStyle -> Q Exp -enumExp parentName tyVars ifaces protos anns cases raw tags bs = +enumExp parentName tyVars ifaces protos anns cases raw tags bs es = do enumInterfaces_ <- Syntax.lift ifaces enumAnnotations_ <- Syntax.lift anns enumProtocols_ <- Syntax.lift protos + encodingStyle_ <- Syntax.lift es applyBase bs $ RecConE 'MoatEnum @@ -1482,7 +1486,8 @@ enumExp parentName tyVars ifaces protos anns cases raw tags bs = ('enumCases, ListE cases), ('enumRawValue, rawValueE raw), ('enumPrivateTypes, ListE []), - ('enumTags, ListE tags) + ('enumTags, ListE tags), + ('enumEncodingStyle, encodingStyle_) ] newtypeExp :: diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index c5fe357..9b20199 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -31,6 +31,7 @@ prettyKotlinData = \case enumName enumTyVars enumCases + enumEncodingStyle indents MoatNewtype {..} -> "" @@ -204,10 +205,12 @@ prettyEnum :: [String] -> -- | cases [(String, [(Maybe String, MoatType)])] -> + -- | encoding style + EncodingStyle -> -- | indents String -> String -prettyEnum anns ifaces name tyVars cases indents +prettyEnum anns ifaces name tyVars cases es indents | isCEnum cases = prettyAnnotations (dontAddSerializeToEnums anns) ++ "enum class " diff --git a/src/Moat/Types.hs b/src/Moat/Types.hs index b82d616..3f59613 100644 --- a/src/Moat/Types.hs +++ b/src/Moat/Types.hs @@ -182,7 +182,9 @@ data MoatData -- | The tags of the struct. See 'Tag'. -- -- Only used by the Swift backend. - enumTags :: [MoatType] + enumTags :: [MoatType], + -- | + enumEncodingStyle :: EncodingStyle } | -- | A newtype. -- Kotlin backend: becomes a value class. @@ -396,7 +398,7 @@ data Options = Options optionalExpand :: Bool, -- | The encoding style for sum of products in Kotlin, -- see 'TaggedObject' and 'TaggedFlatObject' for details - kotlinRenderingStyle :: EncodingStyle + encodingStyle :: EncodingStyle } -- The 'TaggedObject' style will encode a sum of products where the parent sum has @@ -407,6 +409,7 @@ data Options = Options data EncodingStyle = TaggedObjectStyle TaggedObject | TaggedFlatObjectStyle TaggedFlatObject + deriving stock (Eq, Read, Show, Lift) -- | The contents of a tagged object are inside of the 'contentsFieldName', e.g. -- @@ -420,6 +423,7 @@ data TaggedObject = TaggedObject { tagFieldName :: String, contentsFieldName :: String } + deriving stock (Eq, Read, Show, Lift) defaultTaggedObjectEncodingStyle :: EncodingStyle defaultTaggedObjectEncodingStyle = @@ -440,6 +444,7 @@ defaultTaggedObjectEncodingStyle = newtype TaggedFlatObject = TaggedFlatObject { taggedFlatObjectTagFieldName :: String } + deriving stock (Eq, Read, Show, Lift) defaultTaggedFlatObjectEncodingStyle :: EncodingStyle defaultTaggedFlatObjectEncodingStyle = @@ -494,7 +499,7 @@ defaultOptions = makeBase = (False, Nothing, []), optionalExpand = False, -- TODO: we should split backend configuration into their own ADTs - kotlinRenderingStyle = defaultTaggedFlatObjectEncodingStyle + encodingStyle = defaultTaggedFlatObjectEncodingStyle } data KeepOrDiscard = Keep | Discard diff --git a/test/SumOfProductWithTaggedObjectStyleSpec.hs b/test/SumOfProductWithTaggedObjectStyleSpec.hs index b053353..b612c20 100644 --- a/test/SumOfProductWithTaggedObjectStyleSpec.hs +++ b/test/SumOfProductWithTaggedObjectStyleSpec.hs @@ -15,7 +15,7 @@ mobileGenWith ( defaultOptions { dataAnnotations = [Parcelize, Serializable], dataInterfaces = [Parcelable], - kotlinRenderingStyle = defaultTaggedObjectEncodingStyle + encodingStyle = defaultTaggedObjectEncodingStyle } ) ''Record0 @@ -29,7 +29,7 @@ mobileGenWith ( defaultOptions { dataAnnotations = [Parcelize, Serializable], dataInterfaces = [Parcelable], - kotlinRenderingStyle = defaultTaggedObjectEncodingStyle + encodingStyle = defaultTaggedObjectEncodingStyle } ) ''Record1 @@ -42,7 +42,7 @@ mobileGenWith ( defaultOptions { dataAnnotations = [Parcelize, Serializable], dataInterfaces = [Parcelable], - kotlinRenderingStyle = defaultTaggedObjectEncodingStyle + encodingStyle = defaultTaggedObjectEncodingStyle } ) ''Enum From 91e74f0921add6c103516fd00dcc09866fb1408e Mon Sep 17 00:00:00 2001 From: Barry Date: Mon, 15 Nov 2021 14:17:14 -0500 Subject: [PATCH 03/13] Initial implementation --- .../golden | 2 +- src/Moat/Pretty/Kotlin.hs | 52 +++++++++++++++---- 2 files changed, 44 insertions(+), 10 deletions(-) diff --git a/.golden/kotlinEnumSumOfProductWithTaggedObjectStyleSpec/golden b/.golden/kotlinEnumSumOfProductWithTaggedObjectStyleSpec/golden index cf77d55..082e355 100644 --- a/.golden/kotlinEnumSumOfProductWithTaggedObjectStyleSpec/golden +++ b/.golden/kotlinEnumSumOfProductWithTaggedObjectStyleSpec/golden @@ -1,6 +1,6 @@ +@JsonClassDiscriminator("tag") @Parcelize @Serializable -@JsonClassDiscriminator("tag") sealed class Enum : Parcelable { @Parcelize @Serializable diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index 9b20199..02f32d3 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -4,6 +4,7 @@ module Moat.Pretty.Kotlin where import qualified Data.Char as Char +import Data.Functor ((<&>)) import Data.List (intercalate) import Moat.Types @@ -16,7 +17,7 @@ prettyKotlinData :: MoatData -> String prettyKotlinData = \case MoatStruct {..} -> "" - ++ prettyAnnotations structAnnotations + ++ prettyAnnotations noIndent structAnnotations ++ "data class " ++ prettyMoatTypeHeader structName structTyVars ++ "(" @@ -121,8 +122,8 @@ prettyMoatTypeHeader :: String -> [String] -> String prettyMoatTypeHeader name [] = name prettyMoatTypeHeader name tyVars = name ++ "<" ++ intercalate ", " tyVars ++ ">" -prettyAnnotations :: [Annotation] -> String -prettyAnnotations = concatMap (\ann -> "@" ++ prettyAnnotation ann ++ "\n") +prettyAnnotations :: String -> [Annotation] -> String +prettyAnnotations indents = concatMap (\ann -> indents <> "@" ++ prettyAnnotation ann ++ "\n") where prettyAnnotation :: Annotation -> String prettyAnnotation = \case @@ -194,6 +195,24 @@ prettyApp t1 t2 = (args, ret) -> (e1 : args, ret) go e1 e2 = ([e1], e2) +prettySerialName :: String -> [Annotation] -> [(String, [(Maybe String, MoatType)])] -> String -> TaggedObject -> String +prettySerialName 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] -> @@ -212,7 +231,7 @@ prettyEnum :: String prettyEnum anns ifaces name tyVars cases es indents | isCEnum cases = - prettyAnnotations (dontAddSerializeToEnums anns) + prettyAnnotations noIndent (dontAddSerializeToEnums anns) ++ "enum class " ++ prettyMoatTypeHeader name tyVars ++ prettyInterfaces ifaces @@ -221,12 +240,24 @@ prettyEnum anns ifaces name tyVars cases es indents ++ prettyCEnumCases indents (map fst cases) ++ "}" | allConcrete cases = - prettyAnnotations anns - ++ "sealed class " - ++ prettyMoatTypeHeader name tyVars - ++ prettyInterfaces ifaces + case es of + TaggedFlatObjectStyle TaggedFlatObject {} -> + prettyAnnotations noIndent anns + ++ "sealed class " + ++ prettyMoatTypeHeader name tyVars + ++ prettyInterfaces ifaces + TaggedObjectStyle to@TaggedObject {..} -> + prettyAnnotations + noIndent + (RawAnnotation ("JsonClassDiscriminator(\"" <> tagFieldName <> "\")") : anns) + ++ "sealed class " + ++ prettyMoatTypeHeader name tyVars + ++ prettyInterfaces ifaces + ++ " {\n" + ++ prettySerialName name anns cases indents to + ++ "\n}" | otherwise = - prettyAnnotations (dontAddSerializeToEnums anns) + prettyAnnotations noIndent (dontAddSerializeToEnums anns) ++ "enum class " ++ prettyMoatTypeHeader name tyVars ++ prettyInterfaces ifaces @@ -257,3 +288,6 @@ toUpperFirst :: String -> String toUpperFirst = \case [] -> [] (c : cs) -> Char.toUpper c : cs + +noIndent :: String +noIndent = "" From 2d8537ecd49d3e2793a956adbf1522dd5c4f08f8 Mon Sep 17 00:00:00 2001 From: Barry Date: Mon, 15 Nov 2021 14:23:59 -0500 Subject: [PATCH 04/13] Slightly better naming for pretty printer --- src/Moat/Pretty/Kotlin.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index 02f32d3..479bf25 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -195,8 +195,14 @@ prettyApp t1 t2 = (args, ret) -> (e1 : args, ret) go e1 e2 = ([e1], e2) -prettySerialName :: String -> [Annotation] -> [(String, [(Maybe String, MoatType)])] -> String -> TaggedObject -> String -prettySerialName parentName anns cases indents TaggedObject {..} = +prettyTaggedObject :: + String -> + [Annotation] -> + [(String, [(Maybe String, MoatType)])] -> + String -> + TaggedObject -> + String +prettyTaggedObject parentName anns cases indents TaggedObject {..} = intercalate "\n\n" ( cases <&> \(caseNm, [(_, Concrete {concreteName = concreteName})]) -> @@ -254,7 +260,7 @@ prettyEnum anns ifaces name tyVars cases es indents ++ prettyMoatTypeHeader name tyVars ++ prettyInterfaces ifaces ++ " {\n" - ++ prettySerialName name anns cases indents to + ++ prettyTaggedObject name anns cases indents to ++ "\n}" | otherwise = prettyAnnotations noIndent (dontAddSerializeToEnums anns) From e9808ccde248556cfbc7a4f5af7f5810b95bdc82 Mon Sep 17 00:00:00 2001 From: Barry Date: Tue, 16 Nov 2021 10:30:46 -0500 Subject: [PATCH 05/13] Don't assume which annotations to use for the sum type --- src/Moat.hs | 23 ++--- src/Moat/Pretty/Kotlin.hs | 20 ++--- src/Moat/Types.hs | 87 ++++++------------- test/SumOfProductWithTaggedObjectStyleSpec.hs | 13 +-- 4 files changed, 56 insertions(+), 87 deletions(-) diff --git a/src/Moat.hs b/src/Moat.hs index d5d6bd8..f87e8b7 100644 --- a/src/Moat.hs +++ b/src/Moat.hs @@ -44,8 +44,9 @@ module Moat -- ** Option type and defaults Options, defaultOptions, - defaultTaggedObjectEncodingStyle, - defaultTaggedFlatObjectEncodingStyle, + EncodingStyle (..), + SumOfProductEncodingOptions (..), + defaultSumOfProductEncodingOptions, -- ** Helper type for omissions KeepOrDiscard (..), @@ -66,7 +67,7 @@ module Moat omitFields, omitCases, makeBase, - encodingStyle, + sumOfProductEncodingOptions, -- * Pretty-printing @@ -698,7 +699,7 @@ consToMoatType o@Options {..} parentName instTys variant ts bs = \case cases <- forM cons' (liftEither . mkCase o) ourMatch <- matchProxy - =<< lift (enumExp parentName instTys dataInterfaces dataProtocols dataAnnotations cases dataRawValue ts bs encodingStyle) + =<< lift (enumExp parentName instTys dataInterfaces dataProtocols dataAnnotations cases dataRawValue ts bs sumOfProductEncodingOptions) pure [pure ourMatch] liftCons :: (Functor f, Applicative g) => f a -> f [g a] @@ -834,7 +835,7 @@ mkTypeTag Options {..} typName instTys = \case mkName (nameStr typName ++ "Tag") let tag = tagExp typName parentName field False - matchProxy =<< lift (enumExp parentName instTys dataInterfaces dataProtocols dataAnnotations [] dataRawValue [tag] (False, Nothing, []) encodingStyle) + matchProxy =<< lift (enumExp parentName instTys dataInterfaces dataProtocols dataAnnotations [] dataRawValue [tag] (False, Nothing, []) sumOfProductEncodingOptions) _ -> throwError $ NotANewtype typName -- make a newtype into a type alias @@ -873,7 +874,7 @@ mkVoid :: MoatM Match mkVoid Options {..} typName instTys ts = matchProxy - =<< lift (enumExp typName instTys [] [] [] [] Nothing ts (False, Nothing, []) encodingStyle) + =<< lift (enumExp typName instTys [] [] [] [] Nothing ts (False, Nothing, []) sumOfProductEncodingOptions) mkNewtype :: () => @@ -1466,15 +1467,15 @@ enumExp :: [Exp] -> -- | Make base? (Bool, Maybe MoatType, [Protocol]) -> - -- | EncodingStyle - EncodingStyle -> + -- | Documentation + SumOfProductEncodingOptions -> Q Exp -enumExp parentName tyVars ifaces protos anns cases raw tags bs es = +enumExp parentName tyVars ifaces protos anns cases raw tags bs sop = do enumInterfaces_ <- Syntax.lift ifaces enumAnnotations_ <- Syntax.lift anns enumProtocols_ <- Syntax.lift protos - encodingStyle_ <- Syntax.lift es + sumOfProductEncodingOptions_ <- Syntax.lift sop applyBase bs $ RecConE 'MoatEnum @@ -1487,7 +1488,7 @@ enumExp parentName tyVars ifaces protos anns cases raw tags bs es = ('enumRawValue, rawValueE raw), ('enumPrivateTypes, ListE []), ('enumTags, ListE tags), - ('enumEncodingStyle, encodingStyle_) + ('enumSumOfProductEncodingOption, sumOfProductEncodingOptions_) ] newtypeExp :: diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index 479bf25..54a05ad 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -32,7 +32,7 @@ prettyKotlinData = \case enumName enumTyVars enumCases - enumEncodingStyle + enumSumOfProductEncodingOption indents MoatNewtype {..} -> "" @@ -200,9 +200,9 @@ prettyTaggedObject :: [Annotation] -> [(String, [(Maybe String, MoatType)])] -> String -> - TaggedObject -> + SumOfProductEncodingOptions -> String -prettyTaggedObject parentName anns cases indents TaggedObject {..} = +prettyTaggedObject parentName anns cases indents SumOfProductEncodingOptions {..} = intercalate "\n\n" ( cases <&> \(caseNm, [(_, Concrete {concreteName = concreteName})]) -> @@ -231,11 +231,11 @@ prettyEnum :: -- | cases [(String, [(Maybe String, MoatType)])] -> -- | encoding style - EncodingStyle -> + SumOfProductEncodingOptions -> -- | indents String -> String -prettyEnum anns ifaces name tyVars cases es indents +prettyEnum anns ifaces name tyVars cases sop@SumOfProductEncodingOptions {..} indents | isCEnum cases = prettyAnnotations noIndent (dontAddSerializeToEnums anns) ++ "enum class " @@ -246,21 +246,21 @@ prettyEnum anns ifaces name tyVars cases es indents ++ prettyCEnumCases indents (map fst cases) ++ "}" | allConcrete cases = - case es of - TaggedFlatObjectStyle TaggedFlatObject {} -> + case encodingStyle of + TaggedFlatObjectStyle -> prettyAnnotations noIndent anns ++ "sealed class " ++ prettyMoatTypeHeader name tyVars ++ prettyInterfaces ifaces - TaggedObjectStyle to@TaggedObject {..} -> + TaggedObjectStyle -> prettyAnnotations noIndent - (RawAnnotation ("JsonClassDiscriminator(\"" <> tagFieldName <> "\")") : anns) + (sumAnnotations ++ anns) ++ "sealed class " ++ prettyMoatTypeHeader name tyVars ++ prettyInterfaces ifaces ++ " {\n" - ++ prettyTaggedObject name anns cases indents to + ++ prettyTaggedObject name anns cases indents sop ++ "\n}" | otherwise = prettyAnnotations noIndent (dontAddSerializeToEnums anns) diff --git a/src/Moat/Types.hs b/src/Moat/Types.hs index 3f59613..85061dc 100644 --- a/src/Moat/Types.hs +++ b/src/Moat/Types.hs @@ -4,20 +4,18 @@ {-# LANGUAGE DerivingStrategies #-} module Moat.Types - ( MoatType (..), - MoatData (..), + ( Annotation (..), Backend (..), EncodingStyle (..), - TaggedObject (..), - TaggedFlatObject (..), - Protocol (..), Interface (..), - Options (..), KeepOrDiscard (..), - Annotation (..), + MoatData (..), + MoatType (..), + Options (..), + Protocol (..), + SumOfProductEncodingOptions (..), defaultOptions, - defaultTaggedObjectEncodingStyle, - defaultTaggedFlatObjectEncodingStyle, + defaultSumOfProductEncodingOptions, ) where @@ -184,7 +182,7 @@ data MoatData -- Only used by the Swift backend. enumTags :: [MoatType], -- | - enumEncodingStyle :: EncodingStyle + enumSumOfProductEncodingOption :: SumOfProductEncodingOptions } | -- | A newtype. -- Kotlin backend: becomes a value class. @@ -396,62 +394,30 @@ data Options = Options -- will keep it as sugar. A value of 'True' -- will expand it to be desugared. optionalExpand :: Bool, - -- | The encoding style for sum of products in Kotlin, - -- see 'TaggedObject' and 'TaggedFlatObject' for details - encodingStyle :: EncodingStyle + -- | Documentation + sumOfProductEncodingOptions :: SumOfProductEncodingOptions } --- 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 - | TaggedFlatObjectStyle TaggedFlatObject - deriving stock (Eq, Read, Show, Lift) - --- | The contents of a tagged object are inside of the 'contentsFieldName', e.g. --- --- @ --- { --- "tag": ..., --- "contents": ... --- } --- @ -data TaggedObject = TaggedObject - { tagFieldName :: String, +-- Documentation +data SumOfProductEncodingOptions = SumOfProductEncodingOptions + { encodingStyle :: EncodingStyle, + sumAnnotations :: [Annotation], contentsFieldName :: String } deriving stock (Eq, Read, Show, Lift) -defaultTaggedObjectEncodingStyle :: EncodingStyle -defaultTaggedObjectEncodingStyle = - TaggedObjectStyle $ - TaggedObject - { tagFieldName = "tag", - contentsFieldName = "contents" - } - --- | The contents of a tagged flat object are at the same level as the tag, e.g. --- --- @ --- { --- "tag": ..., --- ... --- } --- @ -newtype TaggedFlatObject = TaggedFlatObject - { taggedFlatObjectTagFieldName :: String - } +-- Documentation +data EncodingStyle = TaggedObjectStyle | TaggedFlatObjectStyle deriving stock (Eq, Read, Show, Lift) -defaultTaggedFlatObjectEncodingStyle :: EncodingStyle -defaultTaggedFlatObjectEncodingStyle = - TaggedFlatObjectStyle $ - TaggedFlatObject - { taggedFlatObjectTagFieldName = "tag" - } +-- Documentation +defaultSumOfProductEncodingOptions :: SumOfProductEncodingOptions +defaultSumOfProductEncodingOptions = + SumOfProductEncodingOptions + { encodingStyle = TaggedFlatObjectStyle, + sumAnnotations = [], + contentsFieldName = "contents" + } -- | The default 'Options'. -- @@ -475,7 +441,7 @@ defaultTaggedFlatObjectEncodingStyle = -- , omitCases = const Keep -- , makeBase = (False, Nothing, []) -- , optionalExpand = False --- , kotlinRenderingStyle = defaultTaggedFlatObjectEncodingStyle +-- , sumOfProductEncodingOptions = defaultSumOfProductEncodingOptions -- } -- @ defaultOptions :: Options @@ -498,8 +464,7 @@ defaultOptions = omitCases = const Keep, makeBase = (False, Nothing, []), optionalExpand = False, - -- TODO: we should split backend configuration into their own ADTs - encodingStyle = defaultTaggedFlatObjectEncodingStyle + sumOfProductEncodingOptions = defaultSumOfProductEncodingOptions } data KeepOrDiscard = Keep | Discard diff --git a/test/SumOfProductWithTaggedObjectStyleSpec.hs b/test/SumOfProductWithTaggedObjectStyleSpec.hs index b612c20..948b3bd 100644 --- a/test/SumOfProductWithTaggedObjectStyleSpec.hs +++ b/test/SumOfProductWithTaggedObjectStyleSpec.hs @@ -14,8 +14,7 @@ data Record0 = Record0 mobileGenWith ( defaultOptions { dataAnnotations = [Parcelize, Serializable], - dataInterfaces = [Parcelable], - encodingStyle = defaultTaggedObjectEncodingStyle + dataInterfaces = [Parcelable] } ) ''Record0 @@ -28,8 +27,7 @@ data Record1 = Record1 mobileGenWith ( defaultOptions { dataAnnotations = [Parcelize, Serializable], - dataInterfaces = [Parcelable], - encodingStyle = defaultTaggedObjectEncodingStyle + dataInterfaces = [Parcelable] } ) ''Record1 @@ -42,7 +40,12 @@ mobileGenWith ( defaultOptions { dataAnnotations = [Parcelize, Serializable], dataInterfaces = [Parcelable], - encodingStyle = defaultTaggedObjectEncodingStyle + sumOfProductEncodingOptions = + SumOfProductEncodingOptions + { encodingStyle = TaggedObjectStyle, + sumAnnotations = [RawAnnotation "JsonClassDiscriminator(\"tag\")"], + contentsFieldName = "contents" + } } ) ''Enum From c71eb7644e723b89e5a6c407471f2f9caa6585fb Mon Sep 17 00:00:00 2001 From: Barry Date: Tue, 16 Nov 2021 11:02:55 -0500 Subject: [PATCH 06/13] Add serial name annotation for sum of products --- src/Moat/Pretty/Kotlin.hs | 22 ++++++++++++------- src/Moat/Types.hs | 2 ++ test/SumOfProductWithTaggedObjectStyleSpec.hs | 2 +- 3 files changed, 17 insertions(+), 9 deletions(-) diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index 54a05ad..09e81b8 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -6,6 +6,7 @@ where import qualified Data.Char as Char import Data.Functor ((<&>)) import Data.List (intercalate) +import Data.Maybe (catMaybes) import Moat.Types -- | Convert a 'MoatData' into a canonical representation in Kotlin @@ -17,7 +18,7 @@ prettyKotlinData :: MoatData -> String prettyKotlinData = \case MoatStruct {..} -> "" - ++ prettyAnnotations noIndent structAnnotations + ++ prettyAnnotations Nothing noIndent structAnnotations ++ "data class " ++ prettyMoatTypeHeader structName structTyVars ++ "(" @@ -122,14 +123,18 @@ 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") +prettyAnnotations :: Maybe String -> String -> [Annotation] -> String +prettyAnnotations mCaseNm indents = + concatMap (\ann -> indents <> "@" <> ann <> "\n") + . catMaybes + . fmap prettyAnnotation where - prettyAnnotation :: Annotation -> String + prettyAnnotation :: Annotation -> Maybe String prettyAnnotation = \case JvmInline -> "JvmInline" Parcelize -> "Parcelize" Serializable -> "Serializable" + SerialName -> maybe Nothing (\caseNm -> Just $ "SerialName(\"" <> caseNm <> "\")") mCaseNm RawAnnotation s -> s prettyInterfaces :: [Interface] -> String @@ -206,7 +211,7 @@ prettyTaggedObject parentName anns cases indents SumOfProductEncodingOptions {.. intercalate "\n\n" ( cases <&> \(caseNm, [(_, Concrete {concreteName = concreteName})]) -> - prettyAnnotations indents (anns ++ [RawAnnotation $ "SerialName(\"" <> caseNm <> "\")"]) + prettyAnnotations (Just caseNm) indents anns ++ indents ++ "data class " ++ toUpperFirst caseNm @@ -237,7 +242,7 @@ prettyEnum :: String prettyEnum anns ifaces name tyVars cases sop@SumOfProductEncodingOptions {..} indents | isCEnum cases = - prettyAnnotations noIndent (dontAddSerializeToEnums anns) + prettyAnnotations Nothing noIndent (dontAddSerializeToEnums anns) ++ "enum class " ++ prettyMoatTypeHeader name tyVars ++ prettyInterfaces ifaces @@ -248,12 +253,13 @@ prettyEnum anns ifaces name tyVars cases sop@SumOfProductEncodingOptions {..} in | allConcrete cases = case encodingStyle of TaggedFlatObjectStyle -> - prettyAnnotations noIndent anns + prettyAnnotations Nothing noIndent anns ++ "sealed class " ++ prettyMoatTypeHeader name tyVars ++ prettyInterfaces ifaces TaggedObjectStyle -> prettyAnnotations + Nothing noIndent (sumAnnotations ++ anns) ++ "sealed class " @@ -263,7 +269,7 @@ prettyEnum anns ifaces name tyVars cases sop@SumOfProductEncodingOptions {..} in ++ prettyTaggedObject name anns cases indents sop ++ "\n}" | otherwise = - prettyAnnotations noIndent (dontAddSerializeToEnums anns) + prettyAnnotations Nothing noIndent (dontAddSerializeToEnums anns) ++ "enum class " ++ prettyMoatTypeHeader name tyVars ++ prettyInterfaces ifaces diff --git a/src/Moat/Types.hs b/src/Moat/Types.hs index 85061dc..ae17afd 100644 --- a/src/Moat/Types.hs +++ b/src/Moat/Types.hs @@ -243,6 +243,8 @@ data Annotation Serializable | -- | /escape hatch/ to add an arbitrary annotation RawAnnotation String + | -- | The 'SerialName' annotation only applies for products in sum of products + SerialName deriving stock (Eq, Read, Show) deriving stock (Lift) diff --git a/test/SumOfProductWithTaggedObjectStyleSpec.hs b/test/SumOfProductWithTaggedObjectStyleSpec.hs index 948b3bd..cf812e7 100644 --- a/test/SumOfProductWithTaggedObjectStyleSpec.hs +++ b/test/SumOfProductWithTaggedObjectStyleSpec.hs @@ -38,7 +38,7 @@ data Enum mobileGenWith ( defaultOptions - { dataAnnotations = [Parcelize, Serializable], + { dataAnnotations = [Parcelize, Serializable, SerialName], dataInterfaces = [Parcelable], sumOfProductEncodingOptions = SumOfProductEncodingOptions From d16877454a3fdbc576b564acec15bcb6a22b11ef Mon Sep 17 00:00:00 2001 From: Barry Date: Tue, 16 Nov 2021 11:07:23 -0500 Subject: [PATCH 07/13] Simplify pretty annotation logic --- src/Moat/Pretty/Kotlin.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index 09e81b8..8d9d5f2 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -134,7 +134,7 @@ prettyAnnotations mCaseNm indents = JvmInline -> "JvmInline" Parcelize -> "Parcelize" Serializable -> "Serializable" - SerialName -> maybe Nothing (\caseNm -> Just $ "SerialName(\"" <> caseNm <> "\")") mCaseNm + SerialName -> mCaseNm <&> \caseNm -> "SerialName(\"" <> caseNm <> "\")" RawAnnotation s -> s prettyInterfaces :: [Interface] -> String From c805353da70f4fd91743460f118de52c7481fe5b Mon Sep 17 00:00:00 2001 From: Barry Date: Tue, 16 Nov 2021 11:12:57 -0500 Subject: [PATCH 08/13] Add some docs for prettyAnnotation --- src/Moat/Pretty/Kotlin.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index 8d9d5f2..81193c8 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -123,6 +123,9 @@ prettyMoatTypeHeader :: String -> [String] -> String prettyMoatTypeHeader name [] = name prettyMoatTypeHeader name tyVars = name ++ "<" ++ intercalate ", " tyVars ++ ">" +-- | This function will take a name and the indentation level and render +-- annotations in the style '@{string}\n...'. The name parameter is only used +-- when a 'SerialName' annotation is given for a sum of product prettyAnnotations :: Maybe String -> String -> [Annotation] -> String prettyAnnotations mCaseNm indents = concatMap (\ann -> indents <> "@" <> ann <> "\n") From e8cc031a3c3ee2992c839040bfd8aa988b0ec684 Mon Sep 17 00:00:00 2001 From: Barry Date: Tue, 16 Nov 2021 11:17:13 -0500 Subject: [PATCH 09/13] Add some docs for SerialName --- src/Moat/Types.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Moat/Types.hs b/src/Moat/Types.hs index ae17afd..f537215 100644 --- a/src/Moat/Types.hs +++ b/src/Moat/Types.hs @@ -243,7 +243,9 @@ data Annotation Serializable | -- | /escape hatch/ to add an arbitrary annotation RawAnnotation String - | -- | The 'SerialName' annotation only applies for products in sum of products + | -- | The 'SerialName' annotation is an annotation for products in a sum of + -- products and only applies when used on the sum, see + -- https://kotlin.github.io/kotlinx.serialization/kotlinx-serialization-core/kotlinx-serialization-core/kotlinx.serialization/-serial-name/index.html SerialName deriving stock (Eq, Read, Show) deriving stock (Lift) From 47003b2218376f3aec0bf545afa963c495e8e3ca Mon Sep 17 00:00:00 2001 From: Barry Date: Tue, 16 Nov 2021 11:30:00 -0500 Subject: [PATCH 10/13] Add docs for Types --- src/Moat/Types.hs | 33 ++++++++++++++++++++++++++++----- 1 file changed, 28 insertions(+), 5 deletions(-) diff --git a/src/Moat/Types.hs b/src/Moat/Types.hs index f537215..3325657 100644 --- a/src/Moat/Types.hs +++ b/src/Moat/Types.hs @@ -398,23 +398,46 @@ data Options = Options -- will keep it as sugar. A value of 'True' -- will expand it to be desugared. optionalExpand :: Bool, - -- | Documentation + -- | Only applies for a sum in a sum of products. The options + -- determine the rendering style for the sum of products. + -- The user is responsible for choosing the right options + -- for the products in a SOP. See 'SumOfProductEncodingOptions' sumOfProductEncodingOptions :: SumOfProductEncodingOptions } --- Documentation data SumOfProductEncodingOptions = SumOfProductEncodingOptions - { encodingStyle :: EncodingStyle, + { -- | The encoding style for the sum of product, the library matches the options + -- available in aeson, see + -- https://hackage.haskell.org/package/aeson/docs/Data-Aeson-TH.html#t:SumEncoding + -- and 'EncodingStyle' + encodingStyle :: EncodingStyle, + -- | The annotations to add solely to sum in the sum of product, e.g. + -- in kotlinx.serialization we want to add '@JsonClassDiscriminator("tag")' + -- annotation to the sum type but not the products! sumAnnotations :: [Annotation], + -- | The field name to use for the products, aeson uses "contents" for the TaggedObject + -- style. This is unused in the 'TaggedFlatObjectStyle' contentsFieldName :: String } deriving stock (Eq, Read, Show, Lift) --- Documentation +-- | The resulting enum style for our datatype. This names match +-- the style in Aeson. A 'TaggedObjectStyle' will have a JSON +-- payload like, +-- +-- @ +-- { +-- "tag": ..., +-- "contents": ... +-- } +-- @ +-- +-- In 'TaggedFlatObjectStyle', the contents are unpacked at the same +-- level as "tag" data EncodingStyle = TaggedObjectStyle | TaggedFlatObjectStyle deriving stock (Eq, Read, Show, Lift) --- Documentation +-- | The default 'SumOfProductEncodingOptions' defaultSumOfProductEncodingOptions :: SumOfProductEncodingOptions defaultSumOfProductEncodingOptions = SumOfProductEncodingOptions From 8b4160120c26267da648ad2425fea47063a3e16a Mon Sep 17 00:00:00 2001 From: Barry Date: Tue, 16 Nov 2021 11:32:07 -0500 Subject: [PATCH 11/13] Remove unnecessary note --- src/Moat.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Moat.hs b/src/Moat.hs index f87e8b7..29544dc 100644 --- a/src/Moat.hs +++ b/src/Moat.hs @@ -1467,7 +1467,6 @@ enumExp :: [Exp] -> -- | Make base? (Bool, Maybe MoatType, [Protocol]) -> - -- | Documentation SumOfProductEncodingOptions -> Q Exp enumExp parentName tyVars ifaces protos anns cases raw tags bs sop = From 51123b90126b9abc49792e4ef0422a6812f16c9c Mon Sep 17 00:00:00 2001 From: Barry Date: Tue, 16 Nov 2021 15:49:33 -0500 Subject: [PATCH 12/13] Handle the single data constructor case in sum of product --- .../golden | 14 ++++++ .../golden | 6 +++ moat.cabal | 1 + src/Moat/Pretty/Kotlin.hs | 38 ++++++++++----- ...uctWithTaggedObjectAndSingleNullarySpec.hs | 47 +++++++++++++++++++ 5 files changed, 94 insertions(+), 12 deletions(-) create mode 100644 .golden/kotlinEnumSumOfProductWithTaggedObjectAndSingleNullarySpec/golden create mode 100644 .golden/kotlinRecord0SumOfProductWithTaggedObjectAndSingleNullarySpec/golden create mode 100644 test/SumOfProductWithTaggedObjectAndSingleNullarySpec.hs diff --git a/.golden/kotlinEnumSumOfProductWithTaggedObjectAndSingleNullarySpec/golden b/.golden/kotlinEnumSumOfProductWithTaggedObjectAndSingleNullarySpec/golden new file mode 100644 index 0000000..451ad41 --- /dev/null +++ b/.golden/kotlinEnumSumOfProductWithTaggedObjectAndSingleNullarySpec/golden @@ -0,0 +1,14 @@ +@JsonClassDiscriminator("tag") +@Parcelize +@Serializable +sealed class Enum : Parcelable { + @Parcelize + @Serializable + @SerialName("dataCons0") + data class DataCons0(val contents: Record0) : Enum() + + @Parcelize + @Serializable + @SerialName("dataCons1") + object DataCons1 : Enum() +} \ No newline at end of file diff --git a/.golden/kotlinRecord0SumOfProductWithTaggedObjectAndSingleNullarySpec/golden b/.golden/kotlinRecord0SumOfProductWithTaggedObjectAndSingleNullarySpec/golden new file mode 100644 index 0000000..19c6cfc --- /dev/null +++ b/.golden/kotlinRecord0SumOfProductWithTaggedObjectAndSingleNullarySpec/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/moat.cabal b/moat.cabal index 0ecd988..2c8fb2b 100644 --- a/moat.cabal +++ b/moat.cabal @@ -70,6 +70,7 @@ test-suite spec Common SumOfProductSpec SumOfProductWithLinkEnumInterfaceSpec + SumOfProductWithTaggedObjectAndSingleNullarySpec SumOfProductWithTaggedObjectStyleSpec Moat Moat.Class diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index 81193c8..5209714 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -213,18 +213,32 @@ prettyTaggedObject :: prettyTaggedObject parentName anns cases indents SumOfProductEncodingOptions {..} = intercalate "\n\n" - ( cases <&> \(caseNm, [(_, Concrete {concreteName = concreteName})]) -> - prettyAnnotations (Just caseNm) indents anns - ++ indents - ++ "data class " - ++ toUpperFirst caseNm - ++ "(val " - ++ contentsFieldName - ++ ": " - ++ concreteName - ++ ") : " - ++ parentName - ++ "()" + ( cases <&> \case + (caseNm, [(_, Concrete {concreteName = concreteName})]) -> + prettyAnnotations (Just caseNm) indents anns + ++ indents + ++ "data class " + ++ toUpperFirst caseNm + ++ "(val " + ++ contentsFieldName + ++ ": " + ++ concreteName + ++ ") : " + ++ parentName + ++ "()" + (caseNm, []) -> + prettyAnnotations (Just caseNm) indents anns + ++ indents + ++ "object " + ++ toUpperFirst caseNm + ++ " : " + ++ parentName + ++ "()" + (caseNm, _) -> + error $ + "prettyTaggedObject: The data constructor " + <> caseNm + <> " can have zero or one concrete type constructor!" ) prettyEnum :: diff --git a/test/SumOfProductWithTaggedObjectAndSingleNullarySpec.hs b/test/SumOfProductWithTaggedObjectAndSingleNullarySpec.hs new file mode 100644 index 0000000..682e2e8 --- /dev/null +++ b/test/SumOfProductWithTaggedObjectAndSingleNullarySpec.hs @@ -0,0 +1,47 @@ +module SumOfProductWithTaggedObjectAndSingleNullarySpec where + +import Common +import Moat +import Test.Hspec +import Test.Hspec.Golden +import Prelude hiding (Enum) + +data Record0 = Record0 + { record0Field0 :: Int, + record0Field1 :: Int + } + +mobileGenWith + ( defaultOptions + { dataAnnotations = [Parcelize, Serializable], + dataInterfaces = [Parcelable] + } + ) + ''Record0 + +data Enum + = DataCons0 Record0 + | DataCons1 + +mobileGenWith + ( defaultOptions + { dataAnnotations = [Parcelize, Serializable, SerialName], + dataInterfaces = [Parcelable], + sumOfProductEncodingOptions = + SumOfProductEncodingOptions + { encodingStyle = TaggedObjectStyle, + sumAnnotations = [RawAnnotation "JsonClassDiscriminator(\"tag\")"], + contentsFieldName = "contents" + } + } + ) + ''Enum + +spec :: Spec +spec = + describe "stays golden" $ do + let moduleName = "SumOfProductWithTaggedObjectAndSingleNullarySpec" + it "kotlin" $ + defaultGolden ("kotlinRecord0" <> moduleName) (showKotlin @Record0) + it "kotlin" $ + defaultGolden ("kotlinEnum" <> moduleName) (showKotlin @Enum) From 72b0396a7cb587da9fa00604a3f3aa68e447eaab Mon Sep 17 00:00:00 2001 From: Barry Date: Thu, 18 Nov 2021 13:38:46 -0500 Subject: [PATCH 13/13] Fix merge --- src/Moat/Pretty/Kotlin.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Moat/Pretty/Kotlin.hs b/src/Moat/Pretty/Kotlin.hs index 5209714..20b244f 100644 --- a/src/Moat/Pretty/Kotlin.hs +++ b/src/Moat/Pretty/Kotlin.hs @@ -37,7 +37,7 @@ prettyKotlinData = \case indents MoatNewtype {..} -> "" - ++ prettyAnnotations newtypeAnnotations + ++ prettyAnnotations Nothing noIndent newtypeAnnotations ++ "value class " ++ prettyMoatTypeHeader newtypeName newtypeTyVars ++ "(val " @@ -134,11 +134,11 @@ prettyAnnotations mCaseNm indents = where prettyAnnotation :: Annotation -> Maybe String prettyAnnotation = \case - JvmInline -> "JvmInline" - Parcelize -> "Parcelize" - Serializable -> "Serializable" + JvmInline -> Just "JvmInline" + Parcelize -> Just "Parcelize" + Serializable -> Just "Serializable" SerialName -> mCaseNm <&> \caseNm -> "SerialName(\"" <> caseNm <> "\")" - RawAnnotation s -> s + RawAnnotation s -> Just s prettyInterfaces :: [Interface] -> String prettyInterfaces [] = ""