wip

Author: MartinSStewart

extra/Lamdera/Evergreen/MigrationGenerator.hs

@@ -253,12 +253,17 @@ migrateUnionDefinition_ author pkg oldUnion newUnion tvarMapOld tvarMapNew oldVe
     migration :: Text
     migration = migrationName <> " " <> tvarMigrationTextsCombined
 
-    paramMigrationPairs = zip tvarsOld tvarsNew
+    paramMigrationPairs :: [(N.Name, N.Name)]
+    paramMigrationPairs = filter (\(_, newTVar) -> isTVarInUseUnion newTVar) (zip tvarsOld tvarsNew)
 
     paramMigrationFnsTypeSig :: [Text]
     paramMigrationFnsTypeSig =
       paramMigrationPairs
-        & fmap (\(oldT, newT) -> T.concat [ "(", N.toText oldT, "_old -> ", N.toText newT, "_new)" ] )
+        & fmap (\(oldT, newT) -> T.concat [ "(", N.toText oldT, "_old -> ", N.toText newT, "_new)" ])
+
+    isTVarInUseUnion :: N.Name -> Bool
+    isTVarInUseUnion newTVar =
+        any (\(Can.Ctor _ _ _ params) -> any (isTVarInUse newTVar) params) (Can._u_alts newUnion)
 
     paramMigrationVars :: Text
     paramMigrationVars =
@@ -660,11 +665,11 @@ canAliasToMigration oldVersion newVersion scope interfaces recursionSet (typeNew
             usageParamMigrationFns :: [Text]
             usageParamMigrationFns = usageParamMigrations & fmap migrationFn
 
-            tvarsNew :: [Text]
-            tvarsNew = tvarMapNew & fmap (N.toText . fst)
+            tvarsNew :: [N.Name]
+            tvarsNew = tvarMapNew & fmap fst
 
-            tvarsOld :: [Text]
-            tvarsOld = tvarMapOldReplaced & fmap (N.toText . fst)
+            tvarsOld :: [N.Name]
+            tvarsOld = tvarMapOldReplaced & fmap fst
 
             (MigrationNested migrationAliasedType imps subDefs) =
               let
@@ -680,17 +685,28 @@ canAliasToMigration oldVersion newVersion scope interfaces recursionSet (typeNew
             migrationName :: Text
             migrationName = migrationNameUnderscored newModule oldVersion newVersion typeNameNew
 
-            paramMigrationPairs = zip tvarsOld tvarsNew
+            paramMigrationPairs :: [(N.Name, N.Name)]
+            paramMigrationPairs =
+                filter
+                    (\(_, newTVar) ->
+                        isTVarInUse
+                            newTVar
+                            (case aliasTypeNew of
+                                Can.Holey a -> debugHaskellPass "123123123123" newTVar a
+                                Can.Filled a -> debugHaskellPass "123123123123" newTVar a
+                            )
+                    )
+                    (zip tvarsOld tvarsNew)
 
             paramMigrationFnsTypeSig :: [Text]
             paramMigrationFnsTypeSig =
               paramMigrationPairs
-                & fmap (\(oldT, newT) -> T.concat [ "(", oldT, "_old -> ", newT, "_new)" ] )
+                & fmap (\(oldT, newT) -> T.concat [ "(", N.toText oldT, "_old -> ", N.toText newT, "_new)" ] )
 
             paramMigrationVars :: Text
             paramMigrationVars =
               paramMigrationPairs
-                & fmap (\(oldT, newT) -> T.concat [ "migrate_", oldT ] )
+                & fmap (\(oldT, newT) -> T.concat [ "migrate_", N.toText oldT ] )
                 & T.intercalate " "
 
             oldType = T.concat [moduleNameOld & dropCan & N.toText, ".", typeNameOld & N.toText]
@@ -700,9 +716,9 @@ canAliasToMigration oldVersion newVersion scope interfaces recursionSet (typeNew
             migrationTypeSignature = T.concat
               [ paramMigrationFnsTypeSig & T.intercalate " -> " & suffixIfNonempty " -> "
               , " " , oldType , " "
-              , tvarsOld & fmap (\tvar -> T.concat [tvar, "_old"]) & T.intercalate " "
+              , tvarsOld & fmap (\tvar -> T.concat [N.toText tvar, "_old"]) & T.intercalate " "
               , " -> " , newType , " "
-              , tvarsNew & fmap (\tvar -> T.concat [tvar, "_new"]) & T.intercalate " "
+              , tvarsNew & fmap (\tvar -> T.concat [N.toText tvar, "_new"]) & T.intercalate " "
               ]
 
             applyOldValueIfNotRecord m =

extra/Lamdera/Evergreen/MigrationGeneratorHelpers.hs

@@ -644,6 +644,35 @@ loadTvar tvarMap name =
       -- This would be the alternative:
       -- Can.Tvar name
 
+isTVarInUse :: N.Name -> Can.Type -> Bool
+isTVarInUse tVar typeValue =
+    case typeValue of
+        Can.TLambda a b -> isTVarInUse tVar a || isTVarInUse tVar b
+
+        Can.TVar name -> tVar == name
+
+        Can.TType _ _ typeVars -> any (isTVarInUse tVar) typeVars
+
+        Can.TRecord fields maybeExtension ->
+            any (\(Can.FieldType _ fieldType) -> isTVarInUse tVar fieldType) fields
+            || case maybeExtension of
+                Just extension -> tVar == extension
+                Nothing -> False
+
+        Can.TUnit -> False
+
+        Can.TTuple t0 t1 maybeT2 ->
+          isTVarInUse tVar t0
+              || isTVarInUse tVar t1
+              || case maybeT2 of
+                  Just t2 -> isTVarInUse tVar t2
+                  Nothing -> False
+
+        Can.TAlias moduleNameCanonical name fields aliasType ->
+            any (\(_, fieldType) -> isTVarInUse tVar fieldType) fields
+            || case aliasType of
+                Can.Holey a -> isTVarInUse tVar a
+                Can.Filled a -> isTVarInUse tVar a
 
 tvarResolveParams :: [Can.Type] -> [(N.Name, Can.Type)] -> [Can.Type]
 tvarResolveParams params tvarMap =

test/scenario-migration-generate/src/Migrate_External_Paramed/Actual.elm

@@ -106,8 +106,8 @@ migrate_Migrate_External_Paramed_New_Point2d migrate_units migrate_coordinates o
     old |> migrate_Migrate_External_Paramed_New_Point2d_ migrate_units migrate_coordinates
 
 
-migrate_Migrate_External_Paramed_New_Point2d_ : (units_old -> units_new) -> (coordinates_old -> coordinates_new) -> Migrate_External_Paramed.Old.Point2d_ units_old coordinates_old -> Migrate_External_Paramed.New.Point2d_ units_new coordinates_new
-migrate_Migrate_External_Paramed_New_Point2d_ migrate_units migrate_coordinates old =
+migrate_Migrate_External_Paramed_New_Point2d_ : Migrate_External_Paramed.Old.Point2d_ units_old coordinates_old -> Migrate_External_Paramed.New.Point2d_ units_new coordinates_new
+migrate_Migrate_External_Paramed_New_Point2d_ old =
     case old of
         Migrate_External_Paramed.Old.Point2d_ p0 ->
             Migrate_External_Paramed.New.Point2d_ p0