diff --git a/extra/Lamdera/Wire3/Decoder.hs b/extra/Lamdera/Wire3/Decoder.hs index 228efa902..10c7a41f3 100644 --- a/extra/Lamdera/Wire3/Decoder.hs +++ b/extra/Lamdera/Wire3/Decoder.hs @@ -417,10 +417,11 @@ decoderForType ifaces cname tipe = in decoderForType ifaces cname extendedRecord Nothing -> normalDecoder _ -> - -- Resolve extensible records through TAlias chains, + -- Resolve extensible records through TAlias chains (possibly multi-level), -- e.g. Color = ColorValue { red, green, blue, alpha } - case resolveTvar tvars_ tipe of - TAlias _ _ _ (Filled (TRecord fieldMap Nothing)) -> + -- or Concrete = Level2 { field } where Level2 = Level1 { ... } + case resolveToRecord (resolveTvar tvars_ tipe) of + Just (TRecord fieldMap Nothing) -> let fields = fieldMap & fieldsToList & List.sortOn (\(name, field) -> name) in decodeRecord ifaces cname fields _ -> normalDecoder diff --git a/extra/Lamdera/Wire3/Encoder.hs b/extra/Lamdera/Wire3/Encoder.hs index ac0f84e79..d91afe4c0 100644 --- a/extra/Lamdera/Wire3/Encoder.hs +++ b/extra/Lamdera/Wire3/Encoder.hs @@ -366,12 +366,13 @@ inlineIfRecordOrCall depth ifaces cname tipe tvars aType = Nothing -> normalEncoder _ -> - -- Resolve extensible records through TAlias chains, + -- Resolve extensible records through TAlias chains (possibly multi-level), -- e.g. Color = ColorValue { red, green, blue, alpha } - case resolveTvar tvars tipe of - TAlias _ _ _ (Filled extendedRecord@(TRecord _ Nothing)) -> + -- or Concrete = Level2 { field } where Level2 = Level1 { ... } + case resolveToRecord (resolveTvar tvars tipe) of + Just extendedRecord -> deepEncoderForType depth ifaces cname extendedRecord - _ -> normalEncoder + Nothing -> normalEncoder Filled _ -> normalEncoder {-| Called for encoding tvar type values, i.e. diff --git a/extra/Lamdera/Wire3/Helpers.hs b/extra/Lamdera/Wire3/Helpers.hs index 471143aa2..a1ffee521 100644 --- a/extra/Lamdera/Wire3/Helpers.hs +++ b/extra/Lamdera/Wire3/Helpers.hs @@ -212,6 +212,23 @@ resolvedRecordFieldMapM fieldMap extensibleName tvarMap = Nothing -> Nothing +{-| Recursively resolve TAlias chains until we find a TRecord. +Used by Encoder/Decoder to handle multi-level extensible record chains, +e.g. Level2 compatible = Level1 { compatible | field2 : Int } + Concrete = Level2 { concreteField : Bool } + +A single resolveTvar call may produce TAlias _ _ _ (Filled (TAlias _ _ _ (Filled (TRecord ...)))) +which requires peeling off multiple layers. +-} +resolveToRecord :: Type -> Maybe Type +resolveToRecord tipe = + case tipe of + record@(TRecord _ Nothing) -> Just record + TAlias _ _ tvars (Filled inner) -> + resolveToRecord (resolveTvar tvars inner) + _ -> Nothing + + resolveFieldMap tipe tvarMap = case tipe of TRecord fieldMapExtended maybeNameExtended -> diff --git a/test/Test/Wire.hs b/test/Test/Wire.hs index 67e4c9d06..de382324e 100644 --- a/test/Test/Wire.hs +++ b/test/Test/Wire.hs @@ -131,6 +131,7 @@ wire = do , "src/Test/Wire_Unsupported.elm" , "src/Test/Wire_Unconstructable.elm" , "src/Test/Wire_Union_ForeignRecordAlias.elm" + , "src/Test/Wire_Record_Extensible6_TwoLevel.elm" ] let diff --git a/test/scenario-alltypes/src/Test/Wire_Record_Extensible6_TwoLevel.elm b/test/scenario-alltypes/src/Test/Wire_Record_Extensible6_TwoLevel.elm new file mode 100644 index 000000000..86a2e7a90 --- /dev/null +++ b/test/scenario-alltypes/src/Test/Wire_Record_Extensible6_TwoLevel.elm @@ -0,0 +1,148 @@ +module Test.Wire_Record_Extensible6_TwoLevel exposing (..) + +import Bytes.Decode +import Bytes.Encode +import Lamdera.Wire3 + + +{-| Multi-level extensible record chains where an extensible record +extends another extensible record before being concretely filled. + +This pattern is used by packages like elm-css where Length extends +LengthOrAutoOrCoverOrContain. +-} + + + +-- Two-level chain: Level2 extends Level1, then Concrete fills it in + + +type alias Level1 compatible = + { compatible | level1Field : String } + + +expected_w3_encode_Level1 : ({ compatible | level1Field : String.String } -> Lamdera.Wire3.Encoder) -> Level1 compatible -> Lamdera.Wire3.Encoder +expected_w3_encode_Level1 w3_x_c_compatible = + w3_x_c_compatible + + +expected_w3_decode_Level1 w3_x_c_compatible = + w3_x_c_compatible + + +type alias Level2 compatible = + Level1 { compatible | level2Field : Int } + + +expected_w3_encode_Level2 : ({ compatible | level1Field : String.String, level2Field : Int } -> Lamdera.Wire3.Encoder) -> Level2 compatible -> Lamdera.Wire3.Encoder +expected_w3_encode_Level2 w3_x_c_compatible = + w3_x_c_compatible + + +expected_w3_decode_Level2 w3_x_c_compatible = + w3_x_c_compatible + + +type alias TwoLevelConcrete = + Level2 { concreteField : Bool } + + +expected_w3_encode_TwoLevelConcrete : TwoLevelConcrete -> Lamdera.Wire3.Encoder +expected_w3_encode_TwoLevelConcrete = + \w3_rec_var0 -> + Lamdera.Wire3.encodeSequenceWithoutLength + [ Lamdera.Wire3.encodeBool w3_rec_var0.concreteField + , Lamdera.Wire3.encodeString w3_rec_var0.level1Field + , Lamdera.Wire3.encodeInt w3_rec_var0.level2Field + ] + + +expected_w3_decode_TwoLevelConcrete = + Lamdera.Wire3.succeedDecode + (\concreteField0 level1Field0 level2Field0 -> { concreteField = concreteField0, level1Field = level1Field0, level2Field = level2Field0 }) + |> Lamdera.Wire3.andMapDecode Lamdera.Wire3.decodeBool + |> Lamdera.Wire3.andMapDecode Lamdera.Wire3.decodeString + |> Lamdera.Wire3.andMapDecode Lamdera.Wire3.decodeInt + + + +-- Three-level chain + + +type alias Level3 compatible = + Level2 { compatible | level3Field : Float } + + +expected_w3_encode_Level3 : ({ compatible | level1Field : String.String, level2Field : Int, level3Field : Float } -> Lamdera.Wire3.Encoder) -> Level3 compatible -> Lamdera.Wire3.Encoder +expected_w3_encode_Level3 w3_x_c_compatible = + w3_x_c_compatible + + +expected_w3_decode_Level3 w3_x_c_compatible = + w3_x_c_compatible + + +type alias ThreeLevelConcrete = + Level3 { deepField : Char } + + +expected_w3_encode_ThreeLevelConcrete : ThreeLevelConcrete -> Lamdera.Wire3.Encoder +expected_w3_encode_ThreeLevelConcrete = + \w3_rec_var0 -> + Lamdera.Wire3.encodeSequenceWithoutLength + [ Lamdera.Wire3.encodeChar w3_rec_var0.deepField + , Lamdera.Wire3.encodeString w3_rec_var0.level1Field + , Lamdera.Wire3.encodeInt w3_rec_var0.level2Field + , Lamdera.Wire3.encodeFloat w3_rec_var0.level3Field + ] + + +expected_w3_decode_ThreeLevelConcrete = + Lamdera.Wire3.succeedDecode + (\deepField0 level1Field0 level2Field0 level3Field0 -> { deepField = deepField0, level1Field = level1Field0, level2Field = level2Field0, level3Field = level3Field0 }) + |> Lamdera.Wire3.andMapDecode Lamdera.Wire3.decodeChar + |> Lamdera.Wire3.andMapDecode Lamdera.Wire3.decodeString + |> Lamdera.Wire3.andMapDecode Lamdera.Wire3.decodeInt + |> Lamdera.Wire3.andMapDecode Lamdera.Wire3.decodeFloat + + + +-- Union wrapping two-level concrete types + + +type TwoLevelUnion + = WrapTwoLevel TwoLevelConcrete + | WrapThreeLevel ThreeLevelConcrete + | NoWrap + + +expected_w3_encode_TwoLevelUnion : TwoLevelUnion -> Lamdera.Wire3.Encoder +expected_w3_encode_TwoLevelUnion w3v = + case w3v of + NoWrap -> + Bytes.Encode.unsignedInt8 0 + + WrapThreeLevel v0 -> + Lamdera.Wire3.encodeSequenceWithoutLength [ Bytes.Encode.unsignedInt8 1, w3_encode_ThreeLevelConcrete v0 ] + + WrapTwoLevel v0 -> + Lamdera.Wire3.encodeSequenceWithoutLength [ Bytes.Encode.unsignedInt8 2, w3_encode_TwoLevelConcrete v0 ] + + +expected_w3_decode_TwoLevelUnion = + Bytes.Decode.unsignedInt8 + |> Lamdera.Wire3.andThenDecode + (\w3v -> + case w3v of + 0 -> + Lamdera.Wire3.succeedDecode NoWrap + + 1 -> + Lamdera.Wire3.succeedDecode WrapThreeLevel |> Lamdera.Wire3.andMapDecode w3_decode_ThreeLevelConcrete + + 2 -> + Lamdera.Wire3.succeedDecode WrapTwoLevel |> Lamdera.Wire3.andMapDecode w3_decode_TwoLevelConcrete + + _ -> + Lamdera.Wire3.failDecode + )