Fixed migration generation for tuples containing records that need migration

extra/Lamdera/Evergreen/MigrationGenerator.hs

@@ -579,20 +579,41 @@ canToMigration_ oldVersion newVersion scope interfaces recursionSet typeNew type
       case typeOld of
         Can.TTuple a2 b2 c2m ->
           let
+            -- Helper function to detect if a migration needs lambda wrapping for tuple operations
+            needsLambdaWrap :: Can.Type -> Bool
+            needsLambdaWrap t = isRecord t
+
+            -- Generate unique variable name based on current context to avoid shadowing
+            tupleVarName = nextUniqueRef oldValueRef
+
+            -- Generate migrations with appropriate value references for tuple operations
+            nestedValueRef1 = if needsLambdaWrap a1 then tupleVarName else oldValueRef
             m1@(MigrationNested mfn1 imps1 subDefs1) =
-              canToMigration oldVersion newVersion scope interfaces recursionSet a1 (Just a2) tvarMapOld tvarMapNew oldValueRef
+              canToMigration oldVersion newVersion scope interfaces recursionSet a1 (Just a2) tvarMapOld tvarMapNew nestedValueRef1
+
+            nestedValueRef2 = if needsLambdaWrap b1 then tupleVarName else oldValueRef
             m2@(MigrationNested mfn2 imps2 subDefs2) =
-              canToMigration oldVersion newVersion scope interfaces recursionSet b1 (Just b2) tvarMapOld tvarMapNew oldValueRef
+              canToMigration oldVersion newVersion scope interfaces recursionSet b1 (Just b2) tvarMapOld tvarMapNew nestedValueRef2
+
+            -- Helper function to wrap migrations that need lambda wrapping
+            wrapIfNeeded :: Can.Type -> Text -> Text
+            wrapIfNeeded t migration =
+              if needsLambdaWrap t && T.strip migration /= "" then
+                T.concat ["(\\", tupleVarName, " -> ", migration, ")"]
+              else
+                migration
 
             migrateTuple :: (Text -> Text) -> (Text -> Text) -> (Text -> Text -> Text) -> Migration
             migrateTuple handle1 handle2 handleBoth =
               let
+                wrappedMfn1 = wrapIfNeeded a1 mfn1
+                wrappedMfn2 = wrapIfNeeded b1 mfn2
                 (migration, migrationDefs) =
                   case (T.strip mfn1 == "", T.strip mfn2 == "") of
                     (True, True)   -> ("", Map.empty) -- No migration necessary
-                    (False, True)  -> (handle1 mfn1, subDefs1)
-                    (True, False)  -> (handle2 mfn2, subDefs2)
-                    (False, False) -> (handleBoth mfn1 mfn2, subDefs1 <> subDefs2)
+                    (False, True)  -> (handle1 wrappedMfn1, subDefs1)
+                    (True, False)  -> (handle2 wrappedMfn2, subDefs2)
+                    (False, False) -> (handleBoth wrappedMfn1 wrappedMfn2, subDefs1 <> subDefs2)
               in
               xMigrationNested (migration, imps1 <> imps2, migrationDefs)
           in

test/Test/Lamdera/Evergreen/TestMigrationGenerator.hs

@@ -73,7 +73,7 @@ testMigrationGeneration scenario oldVersion newVersion = do
 
   _ <- io $ Lamdera.Relative.writeFile ("test/scenario-migration-generate/src/Evergreen/Migrate/VX" <> show newVersion <> ".elm") result
 
-  expectEqualTextTrimmed result (mock & withDefault "failed to load file")
+  expectEqualTextTrimmed (mock & withDefault "failed to load file") result
 
   let filenames =
         [ "src/Evergreen/V" <> show oldVersion <> "/Types.elm"

test/scenario-migration-generate/src/Evergreen/Migrate/V2.elm

@@ -112,6 +112,7 @@ migrate_Types_BackendModel old =
     , time = old.time
     , userCache = old.userCache |> migrate_AssocList_Dict identity migrate_IncludedBySpecialCasedParam_Custom
     , apps = (Unimplemented {- Type `Dict (String) (Evergreen.V2.Types.App)` was added in V2. I need you to set a default value. -})
+    , user = old.user |> migrate_Types_User
     , depthTests = (Unimplemented {- Field of type `Dict (String) (Evergreen.V1.Types.Depth)` was removed in V2. I need you to do something with the `old.depthTests` value if you wish to keep the data, then remove this line. -})
     , removed = (Unimplemented {- Field of type `String` was removed in V2. I need you to do something with the `old.removed` value if you wish to keep the data, then remove this line. -})
     , removedRecord = (Unimplemented {- Field of type `Evergreen.V1.External.AllCoreTypes` was removed in V2. I need you to do something with the `old.removedRecord` value if you wish to keep the data, then remove this line. -})
@@ -230,6 +231,30 @@ migrate_Types_FrontendMsg_ old =
             Evergreen.V2.Types.AllCoreTypes (p0 |> migrate_External_AllCoreTypes)
 
 
+migrate_Types_User : Evergreen.V1.Types.User -> Evergreen.V2.Types.User
+migrate_Types_User old =
+    old
+        |> Tuple.mapSecond
+            (\rec ->
+                { name = rec.name
+                , userType = rec.userType |> migrate_Types_UserType
+                , parents =
+                    rec.parents
+                        |> Tuple.mapBoth
+                            (\rec1 ->
+                                { name = rec1.name
+                                , userType = rec1.userType |> migrate_Types_UserType
+                                }
+                            )
+                            (\rec1 ->
+                                { name = rec1.name
+                                , userType = rec1.userType |> migrate_Types_UserType
+                                }
+                            )
+                }
+            )
+
+
 migrate_Types_UserType : Evergreen.V1.Types.UserType -> Evergreen.V2.Types.UserType
 migrate_Types_UserType old =
     case old of

test/scenario-migration-generate/src/Evergreen/V1/Types.elm

@@ -50,8 +50,12 @@ type alias BackendModel =
 
     -- WIP
     , depthTests : Dict String Depth
+    , user : User
     }
 
+type alias User =
+    ( Int, { name : String, userType : UserType, parents: ( { name : String, userType : UserType }, { name : String, userType : UserType } ) } )
+
 
 type UserType
     = UserFirst

test/scenario-migration-generate/src/Evergreen/V2/Types.elm

@@ -49,8 +49,11 @@ type alias BackendModel =
 
     -- WIP
     , apps : Dict String App
+    , user : User
     }
 
+type alias User =
+    ( Int, { name : String, userType : UserType, parents: ( { name : String, userType : UserType }, { name : String, userType : UserType } ) } )
 
 type UserType
     = UserFirst