From cbed35460d5d3a14d008d755a69691e8d7a7c0bf Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Fri, 27 Mar 2026 07:35:22 -0700 Subject: [PATCH] Fix wire codec for multi-level extensible record chains When an extensible record extends another extensible record (e.g. `Level2 compatible = Level1 { compatible | field2 : Int }`), the wire codec generator would only resolve one level of TAlias chain, silently dropping fields from the outermost extension. Adds `resolveToRecord` helper in Helpers.hs that recursively peels TAlias layers until reaching a TRecord. Applied in both Encoder and Decoder Holey branches where `resolveTvar` previously only matched a single TAlias layer. Test: Wire_Record_Extensible6_TwoLevel.elm with two-level and three-level extensible chains, plus a union wrapping both. Co-Authored-By: Claude Opus 4.6 (1M context) --- extra/Lamdera/Wire3/Decoder.hs | 7 +- extra/Lamdera/Wire3/Encoder.hs | 9 +- extra/Lamdera/Wire3/Helpers.hs | 17 ++ test/Test/Wire.hs | 1 + .../Test/Wire_Record_Extensible6_TwoLevel.elm | 148 ++++++++++++++++++ 5 files changed, 175 insertions(+), 7 deletions(-) create mode 100644 test/scenario-alltypes/src/Test/Wire_Record_Extensible6_TwoLevel.elm diff --git a/extra/Lamdera/Wire3/Decoder.hs b/extra/Lamdera/Wire3/Decoder.hs index 408cc2b6b..60f87a49f 100644 --- a/extra/Lamdera/Wire3/Decoder.hs +++ b/extra/Lamdera/Wire3/Decoder.hs @@ -420,10 +420,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 9910c93cb..6516ced9e 100644 --- a/extra/Lamdera/Wire3/Encoder.hs +++ b/extra/Lamdera/Wire3/Encoder.hs @@ -367,12 +367,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 c937649b4..07102260d 100644 --- a/extra/Lamdera/Wire3/Helpers.hs +++ b/extra/Lamdera/Wire3/Helpers.hs @@ -219,6 +219,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 d228f0486..c949ede8c 100644 --- a/test/Test/Wire.hs +++ b/test/Test/Wire.hs @@ -121,6 +121,7 @@ wireTestFiles = , "src/Test/Wire_Unsupported.elm" , "src/Test/Wire_Unconstructable.elm" , "src/Test/Wire_Union_ForeignRecordAlias.elm" + , "src/Test/Wire_Record_Extensible6_TwoLevel.elm" ] 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 + )