From dbc6a5fb276a1df13cb941a92c5bd4098b737112 Mon Sep 17 00:00:00 2001 From: Charlon Date: Wed, 5 Nov 2025 13:35:27 +0700 Subject: [PATCH] Add compiler support for BiSeqDict, MultiSeqDict, and MultiBiSeqDict This adds Wire3 codec generation support for three new container types from lamdera/containers: - BiSeqDict: Bidirectional many-to-one dictionary - MultiSeqDict: One-to-many dictionary - MultiBiSeqDict: Many-to-many bidirectional dictionary Changes: - Add DiffableType constructors for the three new types - Add Wire3 encoder/decoder patterns following SeqDict pattern - Add TypeHash support for type hashing and migrations - Add Evergreen migration helpers for all three types Related PR: https://github.com/lamdera/containers/pull/1 Test repo: https://github.com/supermario/qwertytrewq All three types use the same 2-parameter (key, value) structure as SeqDict and work with opaque types that aren't comparable. --- extra/Lamdera/Evergreen/MigrationGenerator.hs | 15 +++ extra/Lamdera/TypeHash.hs | 30 +++++ extra/Lamdera/Types.hs | 3 + extra/Lamdera/Wire3/Decoder.hs | 117 ++++++++++++++++++ extra/Lamdera/Wire3/Encoder.hs | 45 +++++++ extra/Lamdera/Wire3/Helpers.hs | 12 ++ 6 files changed, 222 insertions(+) diff --git a/extra/Lamdera/Evergreen/MigrationGenerator.hs b/extra/Lamdera/Evergreen/MigrationGenerator.hs index 3bb7b3fa9..5b2cdb114 100644 --- a/extra/Lamdera/Evergreen/MigrationGenerator.hs +++ b/extra/Lamdera/Evergreen/MigrationGenerator.hs @@ -1001,6 +1001,21 @@ typeToMigration oldVersion newVersion scope interfaces recursionSet_ typeNew@(Ca (\m_p1 -> T.concat [ "SeqDict.map (\\k -> ", m_p1, ")" ]) (\m_p0 m_p1 -> T.concat [ "SeqDict.toList |> List.map (Tuple.mapBoth (", m_p0, ") (", m_p1, ")) |> SeqDict.fromList" ]) + ("lamdera", "containers", "BiSeqDict", "BiSeqDict") -> migrate2ParamCollection + (\m_p0 -> T.concat [ "BiSeqDict.toList |> List.map (Tuple.mapFirst ", m_p0, ") |> BiSeqDict.fromList" ]) + (\m_p1 -> T.concat [ "BiSeqDict.map (\\k -> ", m_p1, ")" ]) + (\m_p0 m_p1 -> T.concat [ "BiSeqDict.toList |> List.map (Tuple.mapBoth (", m_p0, ") (", m_p1, ")) |> BiSeqDict.fromList" ]) + + ("lamdera", "containers", "MultiSeqDict", "MultiSeqDict") -> migrate2ParamCollection + (\m_p0 -> T.concat [ "MultiSeqDict.toList |> List.map (Tuple.mapFirst ", m_p0, ") |> MultiSeqDict.fromList" ]) + (\m_p1 -> T.concat [ "MultiSeqDict.map (\\k -> ", m_p1, ")" ]) + (\m_p0 m_p1 -> T.concat [ "MultiSeqDict.toList |> List.map (Tuple.mapBoth (", m_p0, ") (", m_p1, ")) |> MultiSeqDict.fromList" ]) + + ("lamdera", "containers", "MultiBiSeqDict", "MultiBiSeqDict") -> migrate2ParamCollection + (\m_p0 -> T.concat [ "MultiBiSeqDict.toList |> List.map (Tuple.mapFirst ", m_p0, ") |> MultiBiSeqDict.fromList" ]) + (\m_p1 -> T.concat [ "MultiBiSeqDict.map (\\k -> ", m_p1, ")" ]) + (\m_p0 m_p1 -> T.concat [ "MultiBiSeqDict.toList |> List.map (Tuple.mapBoth (", m_p0, ") (", m_p1, ")) |> MultiBiSeqDict.fromList" ]) + (author, pkg, module_, typeName_) -> if (Set.member recursionIdentifier recursionSet_) then handleSeenRecursiveType oldVersion newVersion scope identifierNew interfaces newRecursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef diff --git a/extra/Lamdera/TypeHash.hs b/extra/Lamdera/TypeHash.hs index a29f0023e..6fe8c36c3 100644 --- a/extra/Lamdera/TypeHash.hs +++ b/extra/Lamdera/TypeHash.hs @@ -356,6 +356,27 @@ canonicalToDiffableType targetName interfaces recursionSet canonical tvarMap = _ -> DError "❗️impossible !1 param SeqSet type" + ("lamdera", "containers", "BiSeqDict", "BiSeqDict") -> + case tvarResolvedParams of + key:value:_ -> + DLamderaBiSeqDict (canonicalToDiffableType targetName interfaces recursionSet key tvarMap) (canonicalToDiffableType targetName interfaces recursionSet value tvarMap) + _ -> + DError "❗️impossible !2 param BiSeqDict type" + + ("lamdera", "containers", "MultiSeqDict", "MultiSeqDict") -> + case tvarResolvedParams of + key:value:_ -> + DLamderaMultiSeqDict (canonicalToDiffableType targetName interfaces recursionSet key tvarMap) (canonicalToDiffableType targetName interfaces recursionSet value tvarMap) + _ -> + DError "❗️impossible !2 param MultiSeqDict type" + + ("lamdera", "containers", "MultiBiSeqDict", "MultiBiSeqDict") -> + case tvarResolvedParams of + key:value:_ -> + DLamderaMultiBiSeqDict (canonicalToDiffableType targetName interfaces recursionSet key tvarMap) (canonicalToDiffableType targetName interfaces recursionSet value tvarMap) + _ -> + DError "❗️impossible !2 param MultiBiSeqDict type" + -- Values backed by JS Kernel types we cannot encode/decode ("elm", "virtual-dom", "VirtualDom", "Node") -> kernelError @@ -580,6 +601,9 @@ diffableTypeToText dtype = DExternalWarning _ tipe -> diffableTypeToText tipe DLamderaSeqDict key value -> "LD["<> diffableTypeToText key <>","<> diffableTypeToText value <>"]" DLamderaSeqSet tipe -> "LS["<> diffableTypeToText tipe <>"]" + DLamderaBiSeqDict key value -> "LBD["<> diffableTypeToText key <>","<> diffableTypeToText value <>"]" + DLamderaMultiSeqDict key value -> "LMD["<> diffableTypeToText key <>","<> diffableTypeToText value <>"]" + DLamderaMultiBiSeqDict key value -> "LMBD["<> diffableTypeToText key <>","<> diffableTypeToText value <>"]" diffableTypeErrors :: DiffableType -> [Text] @@ -625,6 +649,9 @@ diffableTypeErrors dtype = DLamderaSeqDict key value -> diffableTypeErrors key ++ diffableTypeErrors value DLamderaSeqSet tipe -> diffableTypeErrors tipe + DLamderaBiSeqDict key value -> diffableTypeErrors key ++ diffableTypeErrors value + DLamderaMultiSeqDict key value -> diffableTypeErrors key ++ diffableTypeErrors value + DLamderaMultiBiSeqDict key value -> diffableTypeErrors key ++ diffableTypeErrors value diffableTypeExternalWarnings :: DiffableType -> [Text] @@ -669,3 +696,6 @@ diffableTypeExternalWarnings dtype = DLamderaSeqDict key value -> diffableTypeExternalWarnings key ++ diffableTypeExternalWarnings value DLamderaSeqSet tipe -> diffableTypeExternalWarnings tipe + DLamderaBiSeqDict key value -> diffableTypeExternalWarnings key ++ diffableTypeExternalWarnings value + DLamderaMultiSeqDict key value -> diffableTypeExternalWarnings key ++ diffableTypeExternalWarnings value + DLamderaMultiBiSeqDict key value -> diffableTypeExternalWarnings key ++ diffableTypeExternalWarnings value diff --git a/extra/Lamdera/Types.hs b/extra/Lamdera/Types.hs index 446547e77..bf60150d9 100644 --- a/extra/Lamdera/Types.hs +++ b/extra/Lamdera/Types.hs @@ -40,6 +40,9 @@ data DiffableType -- Lamdera lib types special cased with support for efficiency | DLamderaSeqDict DiffableType DiffableType | DLamderaSeqSet DiffableType + | DLamderaBiSeqDict DiffableType DiffableType + | DLamderaMultiSeqDict DiffableType DiffableType + | DLamderaMultiBiSeqDict DiffableType DiffableType deriving (Show) diff --git a/extra/Lamdera/Wire3/Decoder.hs b/extra/Lamdera/Wire3/Decoder.hs index b7d056b75..9338a9c13 100644 --- a/extra/Lamdera/Wire3/Decoder.hs +++ b/extra/Lamdera/Wire3/Decoder.hs @@ -341,6 +341,123 @@ decoderForType ifaces cname tipe = , decoderForType ifaces cname val ])) + TType (Module.Canonical (Name "lamdera" "containers") "BiSeqDict") "BiSeqDict" [key, val] -> + (a (Call + (a (VarForeign mLamdera_BiSeqDict "decodeBiSeqDict" + (Forall + (Map.fromList [("k", ()), ("value", ())]) + (TLambda + (TAlias mLamdera_Wire "Decoder" [("a", TVar "k")] + (Filled + (TType + (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") + "Decoder" + [TVar "k"]))) + (TLambda + (TAlias mLamdera_Wire "Decoder" [("a", TVar "value")] + (Filled + (TType + (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") + "Decoder" + [TVar "value"]))) + (TAlias mLamdera_Wire "Decoder" + [ ( "a" + , TType + mLamdera_BiSeqDict + "BiSeqDict" + [TVar "k", TVar "value"]) + ] + (Filled + (TType + (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") + "Decoder" + [ TType + mLamdera_BiSeqDict + "BiSeqDict" + [TVar "k", TVar "value"] + ])))))))) + [ decoderForType ifaces cname key + , decoderForType ifaces cname val + ])) + + TType (Module.Canonical (Name "lamdera" "containers") "MultiSeqDict") "MultiSeqDict" [key, val] -> + (a (Call + (a (VarForeign mLamdera_MultiSeqDict "decodeMultiSeqDict" + (Forall + (Map.fromList [("k", ()), ("value", ())]) + (TLambda + (TAlias mLamdera_Wire "Decoder" [("a", TVar "k")] + (Filled + (TType + (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") + "Decoder" + [TVar "k"]))) + (TLambda + (TAlias mLamdera_Wire "Decoder" [("a", TVar "value")] + (Filled + (TType + (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") + "Decoder" + [TVar "value"]))) + (TAlias mLamdera_Wire "Decoder" + [ ( "a" + , TType + mLamdera_MultiSeqDict + "MultiSeqDict" + [TVar "k", TVar "value"]) + ] + (Filled + (TType + (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") + "Decoder" + [ TType + mLamdera_MultiSeqDict + "MultiSeqDict" + [TVar "k", TVar "value"] + ])))))))) + [ decoderForType ifaces cname key + , decoderForType ifaces cname val + ])) + + TType (Module.Canonical (Name "lamdera" "containers") "MultiBiSeqDict") "MultiBiSeqDict" [key, val] -> + (a (Call + (a (VarForeign mLamdera_MultiBiSeqDict "decodeMultiBiSeqDict" + (Forall + (Map.fromList [("k", ()), ("value", ())]) + (TLambda + (TAlias mLamdera_Wire "Decoder" [("a", TVar "k")] + (Filled + (TType + (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") + "Decoder" + [TVar "k"]))) + (TLambda + (TAlias mLamdera_Wire "Decoder" [("a", TVar "value")] + (Filled + (TType + (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") + "Decoder" + [TVar "value"]))) + (TAlias mLamdera_Wire "Decoder" + [ ( "a" + , TType + mLamdera_MultiBiSeqDict + "MultiBiSeqDict" + [TVar "k", TVar "value"]) + ] + (Filled + (TType + (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") + "Decoder" + [ TType + mLamdera_MultiBiSeqDict + "MultiBiSeqDict" + [TVar "k", TVar "value"] + ])))))))) + [ decoderForType ifaces cname key + , decoderForType ifaces cname val + ])) + TType (Module.Canonical (Name "elm" "bytes") "Bytes") "Bytes" _ -> callDecoder "decodeBytes" tipe diff --git a/extra/Lamdera/Wire3/Encoder.hs b/extra/Lamdera/Wire3/Encoder.hs index 8786f4bc8..7c6552f87 100644 --- a/extra/Lamdera/Wire3/Encoder.hs +++ b/extra/Lamdera/Wire3/Encoder.hs @@ -178,6 +178,39 @@ encoderForType depth ifaces cname tipe = (TType mLamdera_SeqDict "SeqDict" [TVar "key", TVar "value"]) tLamdera_Wire_Encoder)))))) + TType (Module.Canonical (Name "lamdera" "containers") "BiSeqDict") "BiSeqDict" [key, value] -> + (a (VarForeign mLamdera_BiSeqDict "encodeBiSeqDict" + (Forall + (Map.fromList [("key", ()), ("value", ())]) + (TLambda + (TLambda (TVar "key") tLamdera_Wire_Encoder) + (TLambda (TLambda (TVar "value") tLamdera_Wire_Encoder) + (TLambda + (TType mLamdera_BiSeqDict "BiSeqDict" [TVar "key", TVar "value"]) + tLamdera_Wire_Encoder)))))) + + TType (Module.Canonical (Name "lamdera" "containers") "MultiSeqDict") "MultiSeqDict" [key, value] -> + (a (VarForeign mLamdera_MultiSeqDict "encodeMultiSeqDict" + (Forall + (Map.fromList [("key", ()), ("value", ())]) + (TLambda + (TLambda (TVar "key") tLamdera_Wire_Encoder) + (TLambda (TLambda (TVar "value") tLamdera_Wire_Encoder) + (TLambda + (TType mLamdera_MultiSeqDict "MultiSeqDict" [TVar "key", TVar "value"]) + tLamdera_Wire_Encoder)))))) + + TType (Module.Canonical (Name "lamdera" "containers") "MultiBiSeqDict") "MultiBiSeqDict" [key, value] -> + (a (VarForeign mLamdera_MultiBiSeqDict "encodeMultiBiSeqDict" + (Forall + (Map.fromList [("key", ()), ("value", ())]) + (TLambda + (TLambda (TVar "key") tLamdera_Wire_Encoder) + (TLambda (TLambda (TVar "value") tLamdera_Wire_Encoder) + (TLambda + (TType mLamdera_MultiBiSeqDict "MultiBiSeqDict" [TVar "key", TVar "value"]) + tLamdera_Wire_Encoder)))))) + TType (Module.Canonical (Name "elm" "bytes") "Bytes") "Bytes" _ -> (a (VarForeign mLamdera_Wire "encodeBytes" (Forall Map.empty (TLambda tipe tLamdera_Wire_Encoder)))) @@ -306,6 +339,12 @@ deepEncoderForType depth ifaces cname tipe = call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val ] TType (Module.Canonical (Name "lamdera" "containers") "SeqDict") "SeqDict" [key, val] -> call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val ] + TType (Module.Canonical (Name "lamdera" "containers") "BiSeqDict") "BiSeqDict" [key, val] -> + call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val ] + TType (Module.Canonical (Name "lamdera" "containers") "MultiSeqDict") "MultiSeqDict" [key, val] -> + call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val ] + TType (Module.Canonical (Name "lamdera" "containers") "MultiBiSeqDict") "MultiBiSeqDict" [key, val] -> + call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val ] TType (Module.Canonical (Name "elm" "bytes") "Bytes") "Bytes" _ -> encoderForType depth ifaces cname tipe TType (Module.Canonical (Name "elm" "time") "Time") "Posix" _ -> encoderForType depth ifaces cname tipe @@ -401,6 +440,12 @@ encodeTypeValue depth ifaces cname tipe value = call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val, value ] TType (Module.Canonical (Name "lamdera" "containers") "SeqDict") "SeqDict" [key, val] -> call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val, value ] + TType (Module.Canonical (Name "lamdera" "containers") "BiSeqDict") "BiSeqDict" [key, val] -> + call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val, value ] + TType (Module.Canonical (Name "lamdera" "containers") "MultiSeqDict") "MultiSeqDict" [key, val] -> + call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val, value ] + TType (Module.Canonical (Name "lamdera" "containers") "MultiBiSeqDict") "MultiBiSeqDict" [key, val] -> + call (encoderForType depth ifaces cname tipe) [ deepEncoderForType depth ifaces cname key, deepEncoderForType depth ifaces cname val, value ] TType (Module.Canonical (Name "elm" "bytes") "Bytes") "Bytes" _ -> call (encoderForType depth ifaces cname tipe) [ value ] TType (Module.Canonical (Name "elm" "time") "Time") "Posix" _ -> call (encoderForType depth ifaces cname tipe) [ value ] diff --git a/extra/Lamdera/Wire3/Helpers.hs b/extra/Lamdera/Wire3/Helpers.hs index 471143aa2..b01994b50 100644 --- a/extra/Lamdera/Wire3/Helpers.hs +++ b/extra/Lamdera/Wire3/Helpers.hs @@ -758,6 +758,9 @@ tLamdera_Wire_Encoder_Holey = mLamdera_Wire = (Module.Canonical (Name "lamdera" "codecs") "Lamdera.Wire3") mLamdera_SeqDict = (Module.Canonical (Name "lamdera" "containers") "SeqDict") mLamdera_SeqSet = (Module.Canonical (Name "lamdera" "containers") "SeqSet") +mLamdera_BiSeqDict = (Module.Canonical (Name "lamdera" "containers") "BiSeqDict") +mLamdera_MultiSeqDict = (Module.Canonical (Name "lamdera" "containers") "MultiSeqDict") +mLamdera_MultiBiSeqDict = (Module.Canonical (Name "lamdera" "containers") "MultiBiSeqDict") mBytes_Encode = (Module.Canonical (Name "elm" "bytes") "Bytes.Encode") mBytes_Decode = (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") @@ -798,6 +801,15 @@ unwrapAliasesDeep t = TType (Module.Canonical (Name "lamdera" "containers") "SeqDict") "SeqDict" [key, val] -> TType (Module.Canonical (Name "lamdera" "containers") "SeqDict") "SeqDict" [unwrapAliasesDeep key, unwrapAliasesDeep val] + TType (Module.Canonical (Name "lamdera" "containers") "BiSeqDict") "BiSeqDict" [key, val] -> + TType (Module.Canonical (Name "lamdera" "containers") "BiSeqDict") "BiSeqDict" [unwrapAliasesDeep key, unwrapAliasesDeep val] + + TType (Module.Canonical (Name "lamdera" "containers") "MultiSeqDict") "MultiSeqDict" [key, val] -> + TType (Module.Canonical (Name "lamdera" "containers") "MultiSeqDict") "MultiSeqDict" [unwrapAliasesDeep key, unwrapAliasesDeep val] + + TType (Module.Canonical (Name "lamdera" "containers") "MultiBiSeqDict") "MultiBiSeqDict" [key, val] -> + TType (Module.Canonical (Name "lamdera" "containers") "MultiBiSeqDict") "MultiBiSeqDict" [unwrapAliasesDeep key, unwrapAliasesDeep val] + TType moduleName typeName params -> -- t -- @TODO wrong to not de-alias params? TType moduleName typeName (fmap unwrapAliasesDeep params)