diff --git a/extra/Lamdera/Evergreen/MigrationGenerator.hs b/extra/Lamdera/Evergreen/MigrationGenerator.hs index 5039705e7..3bb7b3fa9 100644 --- a/extra/Lamdera/Evergreen/MigrationGenerator.hs +++ b/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 diff --git a/test/Test/Lamdera/Evergreen/TestMigrationGenerator.hs b/test/Test/Lamdera/Evergreen/TestMigrationGenerator.hs index d9cdcfa88..ac2b92785 100644 --- a/test/Test/Lamdera/Evergreen/TestMigrationGenerator.hs +++ b/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" diff --git a/test/scenario-migration-generate/src/Evergreen/Migrate/V2.elm b/test/scenario-migration-generate/src/Evergreen/Migrate/V2.elm index de9c21d2e..e8b9359dd 100644 --- a/test/scenario-migration-generate/src/Evergreen/Migrate/V2.elm +++ b/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 diff --git a/test/scenario-migration-generate/src/Evergreen/V1/Types.elm b/test/scenario-migration-generate/src/Evergreen/V1/Types.elm index 6b42e80e6..aafed4f1f 100644 --- a/test/scenario-migration-generate/src/Evergreen/V1/Types.elm +++ b/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 diff --git a/test/scenario-migration-generate/src/Evergreen/V2/Types.elm b/test/scenario-migration-generate/src/Evergreen/V2/Types.elm index bfdbc4191..e1f75d217 100644 --- a/test/scenario-migration-generate/src/Evergreen/V2/Types.elm +++ b/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