content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE QuasiQuotes #-}
  
  module Lamdera.Evergreen.MigrationGenerator where
  
  import Data.Map (Map)
  import qualified Data.Map as Map
  import qualified Sanity
  import qualified Data.Set as Set
  import qualified Data.List as List
  import qualified Data.Text as T
  import qualified Data.Name as N
  import NeatInterpolation
  
  import qualified AST.Canonical as Can
  import qualified Elm.ModuleName as ModuleName
  import qualified Elm.Package as Pkg
  import qualified Elm.Interface as Interface
  import qualified Data.Utf8 as Utf8
  import qualified Data.NonEmptyList as NE
  
  import qualified Ext.Common
  import Lamdera
  import Lamdera.Types
  import qualified Lamdera.Compile
  import qualified Ext.ElmFormat
  import qualified Ext.Query.Interfaces
  import qualified Lamdera.Wire3.Helpers
  -- import StandaloneInstances
  
  import Lamdera.Evergreen.MigrationGeneratorHelpers
  import Lamdera.Evergreen.MigrationSpecialCases
  
  betweenVersions :: CoreTypeDiffs -> Int -> Int -> String -> IO Text
  betweenVersions coreTypeDiffs oldVersion newVersion root = do
      let
          paths = NE.List ("src/Evergreen/V" <> show oldVersion <> "/Types.elm") ["src/Evergreen/V" <> show newVersion <> "/Types.elm"]
          moduleNameString = "Evergreen.V" <> show newVersion <> ".Types"
  
      Lamdera.Compile.makeDev root (NE.toList paths)
  
      res <- Ext.Common.withProjectRoot root $ do
        interfaces <- Ext.Query.Interfaces.all (NE.toList paths)
        case Map.lookup (N.fromChars moduleNameString) interfaces of
          Just interface -> do
            debug $ "starting generatefor"
            generateFor coreTypeDiffs oldVersion newVersion interfaces (interfaces Sanity.! (N.fromChars $ "Evergreen.V" <> show newVersion <> ".Types"))
  
          Nothing ->
            error $ "Fatal: could not find the module `" <> moduleNameString <> "`, please report this issue in Discord with your project code."
  
      pure $ Ext.ElmFormat.formatOrPassthrough res
  
  generateFor :: CoreTypeDiffs -> Int -> Int -> Interfaces -> Interface.Interface -> IO Text
  generateFor coreTypeDiffs oldVersion newVersion interfaces iface_Types = do
    let
      moduleName :: ModuleName.Canonical
      moduleName = ModuleName.Canonical (Pkg.Name "author" "project") (N.fromChars $ "Evergreen.V" <> show newVersion <> ".Types")
  
      migrationModuleText = T.concat ["Evergreen.Migrate.V", show_ newVersion]
  
      coreMigrations :: [(N.Name, Migration)]
      coreMigrations =
        coreTypeDiffs
          & fmap (\(t, oldHash, newHash) ->
              (t, coreTypeMigration (oldHash /= newHash) oldVersion newVersion interfaces moduleName t iface_Types)
          )
    pure $ migrationsToFile migrationModuleText oldVersion newVersion coreMigrations moduleName
  
  
  migrationsToFile :: Text -> Int -> Int -> [(N.Name, Migration)] -> ModuleName.Canonical -> Text
  migrationsToFile migrationModuleText oldVersion newVersion migrations moduleName =
    let
      imports :: Text
      imports = migrations
        & fmap snd
        & allImports
        -- a little weird but ensures current version of types, our entry point, is added to final migration imports...
        & Set.insert moduleName
        & importsToText
        & (++) additionalImports
        & List.sort
        & List.nub
        & T.intercalate "\n"
  
      additionalImports :: [Text]
      additionalImports = ["import Lamdera.Migrations exposing (..)"]
  
      coreMigrationDefs = migrations & fmap (migrationFn . snd)
  
      subMigrations = migrations & fmap (migrationTopLevelDefs . snd) & mergeAllSubDefs & allMigrations
  
      output =
        [ T.concat [ "module ", migrationModuleText, " exposing (..)" ]
        , helpfulInformation
        , imports
        ] ++ coreMigrationDefs ++ [ subMigrations ]
    in
    output & T.intercalate "\n\n"
  
  
  helpfulInformation :: Text
  helpfulInformation =
    -- @TODO currently silly hack, but the 'Unimplemented' keyword is naively used to check if there are
    -- any pending migrations... but that means we can't use that word in comments, so we use the utf8 substitute
    -- character trick in the `Unimplementеd` text below which won't match on the basic string search.
    -- In future the better resolution would be to detect the Unimplemented keyword in the AST, so the user
    -- can just comment stuff out but leave it for record.
    [text|
      {-| This migration file was automatically generated by the lamdera compiler.
  
      It includes:
  
        - A migration for each of the 6 Lamdera core types that has changed
        - A function named `migrate_ModuleName_TypeName` for each changed/custom type
  
      Expect to see:
  
        - `Unimplementеd` values as placeholders wherever I was unable to figure out a clear migration path for you
        - `@NOTICE` comments for things you should know about, i.e. new custom type constructors that won't get any
          value mappings from the old type by default
  
      You can edit this file however you wish! It won't be generated again.
  
      See <https://dashboard.lamdera.app/docs/evergreen> for more info.
      -}
    |]
  
  
  coreTypeMigration :: Bool -> Int -> Int -> Interfaces -> ModuleName.Canonical -> N.Name -> Interface.Interface -> Migration
  coreTypeMigration typeDidChange oldVersion newVersion interfaces newModule typeName interface = do
    let
      recursionIdentifier :: (ModuleName.Canonical, N.Name)
      recursionIdentifier = (newModule, typeName)
  
      recursionSet :: RecursionSet
      recursionSet = Set.singleton recursionIdentifier
  
      identifier :: TypeIdentifier
      identifier = asIdentifier_ recursionIdentifier
  
      t :: Text
      t = nameToText typeName
  
      newModuleName :: Text
      newModuleName = newModule & dropCan & N.toText
  
      oldModule :: ModuleName.Canonical
      oldModule = asOldModule (dropCan newModule) newVersion oldVersion
  
      oldModuleName :: Text
      oldModuleName = oldModule & dropCan & N.toText
  
      migrationWrapper :: Text -> Text
      migrationWrapper migration = do
        T.concat
          ["\n", lowerFirstLetter_ t, " : ", oldModuleName, ".", t, " -> ", migrationTypeForType typeName , " ", newModuleName, ".", t, " ", newModuleName, ".", msgForType typeName, "\n"
          , lowerFirstLetter_ $ nameToText typeName, " old =\n    ", migration
          ]
  
    if typeDidChange
      then
        case (findDef oldModule typeName interfaces, findDef newModule typeName interfaces) of
          (Just (Alias mOld typeNameOld aliasOld), Just (Alias mNew typeNameNew aliasNew)) -> do
            let
              aliasDefMigration = migrateAliasDefinition oldVersion newVersion mOld newModule identifier typeNameOld typeNameNew interfaces recursionSet aliasOld aliasNew "old" [] []
              (MigrationNested migrationImpl imps subDefs) = aliasDefMigration
              migration = T.concat ["\n    ", migrationWrapperForType typeName, " ( ", migrationImpl, " old, Cmd.none )"]
            (MigrationNested (migrationWrapper migration) imps subDefs)
  
          (Just typeDefOld@(Union mOld typeNameOld unionOld), Just (Union mNew typeNameNew unionNew)) -> do
            let
              unionDefMigration = migrateUnionDefinition typeDefOld oldVersion newVersion newModule identifier typeName interfaces recursionSet [] [] unionNew
  
              (MigrationNested migrationImpl imps subDefs) = unionDefMigration
              migration = T.concat ["\n    ", migrationWrapperForType typeName, " ( ", migrationImpl, " old, Cmd.none )"]
            (MigrationNested (migrationWrapper migration) imps subDefs)
  
          (Nothing, _) ->
            error $ concat [ "Tried to generate a migration for core type ", N.toChars typeName, ", but I couldn't find it defined in src/Evergree/V", show oldVersion, "/Types.elm" ]
  
          (_, Nothing) ->
            error $ concat [ "Tried to generate a migration for core type ", N.toChars typeName, ", but I couldn't find it defined in src/Evergree/V", show newVersion, "/Types.elm" ]
  
          _ ->
            unimplemented (T.concat ["coreTypeMigration"])
              (T.concat [ "Core type changed in an unexpected way. I need you to write this migration." ])
      else
        (MigrationNested (migrationWrapper (unchangedForType typeName)) Set.empty Map.empty)
  
  
  -- A top level Custom Type definition i.e. `type Herp = Derp ...`
  migrateUnionDefinition :: TypeDef -> Int -> Int -> ModuleName.Canonical -> TypeIdentifier -> N.Name -> Interfaces -> RecursionSet -> TvarMap -> TvarMap -> Can.Union -> Migration
  migrateUnionDefinition typeDefOld oldVersion newVersion scope identifier@(author, pkg, newModule, tipe) typeNameNew interfaces recursionSet tvarMapOld tvarMapNew newUnion =
    case typeDefOld of
      (Alias moduleNameOld typeNameOld aliasOld) ->
        unimplemented "" ("`" <> N.toText typeNameNew <> "` was a type alias, but now it's a custom type. I need you to write this migration.")
      (Union moduleNameOld typeNameOld unionOld) ->
        migrateUnionDefinition_ author pkg unionOld newUnion tvarMapOld tvarMapNew oldVersion newVersion typeNameNew newModule identifier (dropCan moduleNameOld) interfaces recursionSet scope
  
  
  migrateUnionDefinition_ :: Pkg.Author -> Pkg.Project -> Can.Union -> Can.Union -> TvarMap -> TvarMap -> Int -> Int -> N.Name -> N.Name -> TypeIdentifier -> N.Name -> Interfaces -> RecursionSet -> ModuleName.Canonical -> Migration
  migrateUnionDefinition_ author pkg oldUnion newUnion tvarMapOld tvarMapNew oldVersion newVersion typeName newModule identifier oldModuleName interfaces recursionSet scope =
    let
      oldModuleNameCanonical :: ModuleName.Canonical
      oldModuleNameCanonical = ModuleName.Canonical (Pkg.Name author pkg) oldModuleName
  
      newModuleNameCanonical :: ModuleName.Canonical
      newModuleNameCanonical = ModuleName.Canonical (Pkg.Name author pkg) newModule
  
      tvarsNew :: [N.Name]
      tvarsNew = Can._u_vars newUnion
  
      tvarsOld :: [N.Name]
      tvarsOld = Can._u_vars oldUnion
  
      tvarPairs :: [(Can.Type, Can.Type)]
      tvarPairs =
        zip (loadTvars (fmap fst paramMigrationPairs) tvarMapOld) (loadTvars (fmap snd paramMigrationPairs) tvarMapNew)
  
      tvarMigrations :: [Migration]
      tvarMigrations =  migrateTvars oldVersion newVersion scope interfaces recursionSet tvarMapOld tvarMapNew tvarPairs
  
      tvarMigrationTextsCombined :: Text
      tvarMigrationTextsCombined = tvarMigrations & fmap migrationFn & parenthesize & T.intercalate " "
  
      localScope :: ModuleName.Canonical
      localScope = ModuleName.Canonical (Pkg.Name author pkg) newModule
  
      constructorMigrations :: [Migration]
      constructorMigrations =
        Can._u_alts oldUnion
          & fmap (\(Can.Ctor oldConstructor index int oldParams) ->
            -- For each OLD constructor type param
            -- Note we reset the tvars here, because constructor migrations are always going to be definition migrations, so we want to honor any top level tvars
            genOldConstructorMigration oldModuleName moduleScope typeName interfaces [] [] recursionSet localScope newVersion oldVersion newUnion oldUnion oldConstructor oldParams
              & debugMigrationIncludes_ "genOldConstructorMigration" (oldUnion, newUnion, tvarMapOld, tvarMapNew)
          )
  
      constructorsMigrationDefinitions :: MigrationDefinitions
      constructorsMigrationDefinitions = constructorMigrations & allSubDefs
  
      moduleScope :: Text
      moduleScope = nameToText newModule <> "."
  
      moduleScopeOld :: Text
      moduleScopeOld = nameToText oldModuleName <> "."
  
      migrationName :: Text
      migrationName = migrationNameUnderscored newModule oldVersion newVersion typeName
  
      migration :: Text
      migration = migrationName <> " " <> tvarMigrationTextsCombined
  
      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)" ])
  
      isTVarInUseUnion :: N.Name -> Bool
      isTVarInUseUnion newTVar =
          any (\(Can.Ctor _ _ _ params) -> any (isTVarInUse newTVar) params) (Can._u_alts newUnion)
  
      paramMigrationVars :: Text
      paramMigrationVars =
        paramMigrationPairs
          & fmap (\(oldT, newT) -> T.concat [ "migrate_", N.toText oldT ] )
          & T.intercalate " "
  
      migrationTypeSignature :: Text
      migrationTypeSignature = T.concat
        [ paramMigrationFnsTypeSig & T.intercalate " -> " & suffixIfNonempty " -> "
        , " "
        , oldModuleName & N.toText, ".", typeName & N.toText
        , " "
        , tvarsOld & fmap (\tvar -> T.concat [N.toText tvar, "_old"]) & T.intercalate " "
        , " -> "
        , newModule & N.toText, ".", typeName & N.toText
        , " "
        , tvarsNew & fmap (\tvar -> T.concat [N.toText tvar, "_new"]) & T.intercalate " "
        ]
  
      constructorCaseMigrations :: Text
      constructorCaseMigrations =
        constructorMigrations
          & fmap migrationFn
          & flip (++) newConstructorWarnings
          & T.concat
  
      newConstructorWarnings :: [Text]
      newConstructorWarnings =
        Can._u_alts newUnion
          & filterMap (\(Can.Ctor newConstructorName index int newParams) -> do
            case Can._u_alts oldUnion & List.find (\(Can.Ctor oldConstructorName _ _ _) ->
                   newConstructorName == oldConstructorName
              ) of
              Nothing ->
                let params =
                      if length newParams > 0
                        then " " <> (T.intercalate " " (fmap qualifiedTypeName newParams))
                        else ""
                in
                -- This constructor is missing a match in the old type, warn the user this new constructor exists
                Just $ T.concat [
                  "        {- @NOTICE `", N.toText newConstructorName, params, "` was added in V", show_ newVersion, ".\n",
                  "        This is just a reminder in case migrating some subset of the old data to this new value was important.\n",
                  "        See https://dashboard.lamdera.app/tips/modified-custom-type for more info.\n",
                  "        -}\n"
                  ]
              Just _ ->
                -- This constructor has a match in the old type, so skip it
                Nothing
          )
          & (\notices ->
                if length notices > 0 then
                  [ "    notices ->\n" <>
                    "        " <> T.concat notices <> "\n" <>
                    "        (Unimplemented {- New constructors were added. I need you to resolve the above notices and then remove this case. -})"
                  ]
                else
                  []
            )
    in
  
    case specialCaseMigration identifier migration tvarMigrations of
      Just (fn, def, tvarMigrations_) ->
        MigrationNested
          fn
          (Set.fromList [oldModuleNameCanonical, newModuleNameCanonical])
          (def
            & Map.singleton (newModuleNameCanonical, typeName)
            & Map.union (allSubDefs tvarMigrations_)
          )
          & debugMigrationIncludes_ "migrateUnionDefinition_:specialCased" (oldUnion, newUnion)
  
      Nothing ->
        xMigrationNested
        ( migration
        , Set.empty
        , (MigrationDefinition
              { migrationDefImports = Set.fromList [oldModuleNameCanonical, newModuleNameCanonical]
              , migrationDef =
                -- Map.singleton migrationName $
                T.concat
                  [ migrationName, " : ", migrationTypeSignature, "\n"
                  , [ migrationName, paramMigrationVars, " old =\n" ] & T.intercalate " "
                  , "  case old of\n"
                  , constructorCaseMigrations
                  ]
              }
              & Map.singleton (newModuleNameCanonical, typeName)
            )
            & Map.union (allSubDefs tvarMigrations)
            & Map.union constructorsMigrationDefinitions
        )
        & debugMigrationIncludes_ "migrateUnionDefinition_" (oldUnion, newUnion)
  
  
  genOldConstructorMigration :: N.Name -> Text -> N.Name -> Interfaces -> TvarMap -> TvarMap -> RecursionSet -> ModuleName.Canonical -> Int -> Int -> Can.Union -> Can.Union -> N.Name -> [Can.Type] -> Migration
  genOldConstructorMigration oldModuleName moduleScope typeName interfaces tvarMapOld tvarMapNew recursionSet localScope newVersion oldVersion newUnion oldUnion oldConstructorName oldParams =
    let
      newCtorM :: Maybe Can.Ctor
      newCtorM = Can._u_alts newUnion & List.find (\(Can.Ctor newConstructorName _ _ _) ->
        newConstructorName == oldConstructorName
        || (newConstructorName == (oldConstructorName & N.toText & (\v -> v <> "_") & N.fromText))
        )
  
      migration_ :: Migration
      migration_ =
        case newCtorM of
        Just (Can.Ctor newConstructorName _ _ newParams) ->
          let
              paramMigrations :: [Migration]
              paramMigrations =
                zipFull oldParams newParams
                  & imap (\i (paramOldM, paramNewM) ->
                    case (paramOldM, paramNewM) of
                      (Just paramOld, Just paramNew) ->
                        let ft@(MigrationNested fn imps subDefs) =
                              canToMigration oldVersion newVersion localScope interfaces recursionSet paramNew (Just paramOld) tvarMapOld tvarMapNew ("p" <> show_ i)
  
                            appliedMigration =
                              if fn == "" then
                                xMigrationNested (T.concat ["p", show_ i], Set.empty, Map.empty)
                              else if isAnonymousRecord paramOld then
                                ft
                              else if isUserDefinedType_ paramOld then
                                xMigrationNested (T.concat ["(p", show_ i, " |> ", fn, ")"], imps, subDefs)
                              else
                                xMigrationNested (T.concat ["(p", show_ i, " |> ", fn, ")"], imps, subDefs)
                        in
                        appliedMigration
  
                      (Just paramOld, Nothing) ->
                        unimplemented "migrateParam:noNew" ("Warning: old variant didn't get mapped to anything, check this is what you want")
  
                      (Nothing, Just paramNew) ->
                        unimplemented "migrateParam:noOld" ("This new variant needs to be initialised")
  
                      _ -> error "migrateParam:impossible, zip produced a value without any contents"
                  )
  
              fullMigration =
                xMigrationNested ( if List.length oldParams > 0 then
                    let
                      migration =
                        paramMigrations
                          & fmap migrationFn
                          & (\migrationFns ->
                              if T.length (migrationFns & T.intercalate " ") > 50 then
                                T.concat [ moduleScope, N.toText newConstructorName, " ", (migrationFns & T.intercalate "\n        ") ]
                              else
                                T.concat [ moduleScope, N.toText newConstructorName, " ", (migrationFns & T.intercalate " ") ]
                            )
                    in
                    T.concat
                        [ "    ", N.toText oldModuleName, ".", N.toText oldConstructorName, " ", (imap (\i _ -> "p" <> show_ i) oldParams & T.intercalate " ")
                        , " -> \n"
                        , migration & T.lines & fmap (\v -> T.concat ["        ", v ]) & T.unlines
                        , "\n"
                        ]
                  else
                    T.concat ["    ", N.toText oldModuleName, ".", N.toText oldConstructorName, " ->\n        ", moduleScope, N.toText newConstructorName, "\n"]
                , paramMigrations
                    & fmap migrationFnImports
                    & Set.unions
                , paramMigrations
                    & fmap migrationTopLevelDefs
                    & mergeAllSubDefs
                )
                & debugMigrationIncludes_ "genOldConstructorMigration:paramMigration" (oldParams, newParams)
          in
          fullMigration
  
        Nothing ->
          let
            oldConstructorRemovedMessage :: Text
            oldConstructorRemovedMessage =
              T.concat [
                " ->\n",
                "           (Unimplemented\n",
                "           {- `", N.toText oldConstructorName, "` was removed or renamed in V", show_ newVersion, " so I couldn't figure out how to migrate it.\n",
                "           I need you to decide what happens to this ", N.toText oldModuleName, ".", N.toText oldConstructorName, " value in a migration.\n",
                "           See https://dashboard.lamdera.app/tips/modified-custom-type for more info.\n",
                "           -})\n"
              ]
          in
          xMigrationNested ( -- No old constructor with same name, so this is a new/renamed constructor
            if List.length oldParams > 0
              then
                T.concat ["    ", N.toText oldModuleName, ".", N.toText oldConstructorName, " ", (imap (\i _ -> "p" <> show_ i) oldParams & T.intercalate " "), oldConstructorRemovedMessage]
              else
                T.concat ["    ", N.toText oldModuleName, ".", N.toText oldConstructorName, oldConstructorRemovedMessage]
          , Set.empty
          , Map.empty
          )
    in
    migration_
  
  
  -- A top level Alias definition i.e. `type alias ...`
  migrateAliasDefinition :: Int -> Int -> ModuleName.Canonical -> ModuleName.Canonical -> TypeIdentifier -> TypeName -> TypeName -> Interfaces -> RecursionSet -> Can.Alias -> Can.Alias -> Text -> TvarMap -> TvarMap -> Migration
  migrateAliasDefinition oldVersion newVersion moduleOld scope identifier@(author, pkg, newModule, typeNameNew) typeNameOld typeName interfaces recursionSet aliasOld@(Can.Alias tvarsOld typeOld) aliasNew@(Can.Alias tvarsNew typeNew) oldValueRef tvarMapOld tvarMapNew =
    let
      (MigrationNested migration imps subDefs) = canToMigration oldVersion newVersion scope interfaces recursionSet typeNew (Just typeOld) tvarMapOld tvarMapNew oldValueRef
  
      -- @TODO remove
      oldModuleNameCanonical :: ModuleName.Canonical
      oldModuleNameCanonical = moduleOld
  
      newModuleNameCanonical :: ModuleName.Canonical
      newModuleNameCanonical = ModuleName.Canonical (Pkg.Name author pkg) newModule
  
      tvarPairs :: [(Can.Type, Can.Type)]
      tvarPairs = zip (loadTvars tvarsOld tvarMapOld) (loadTvars tvarsOld tvarMapOld)
  
      tvarMigrations :: [Migration]
      tvarMigrations = migrateTvars oldVersion newVersion scope interfaces recursionSet tvarMapOld tvarMapNew tvarPairs
  
      tvarMigrationTextsCombined :: Text
      tvarMigrationTextsCombined = tvarMigrations & fmap migrationFn & parenthesize & T.intercalate " "
  
      moduleName = (ModuleName.Canonical (Pkg.Name author pkg) newModule)
  
      newModuleName = newModule & N.toText
      oldModuleName = moduleOld & dropCan & N.toText
  
      migrationName_ :: Text
      migrationName_ = migrationNameUnderscored newModule oldVersion newVersion typeName
  
      migration_ :: Text
      migration_ = migrationName_ <> " " <> tvarMigrationTextsCombined
  
      applyOldValueIfNotRecord = if isRecord typeNew then "" else T.concat [oldValueRef, " |> "]
    in
    case specialCaseMigration identifier migration_ tvarMigrations of
      Just (fn, def, tvarMigrations_) ->
        MigrationNested
          fn
          (Set.fromList [moduleOld, newModuleNameCanonical])
          (def
            & Map.singleton (newModuleNameCanonical, typeNameNew)
            & Map.union (allSubDefs tvarMigrations_)
          )
          & debugMigrationIncludes_ "migrateAliasDefinition:specialCased" (aliasOld, aliasNew)
  
      Nothing ->
        xMigrationNested
        ( migration_
        , Set.fromList [moduleOld, newModuleNameCanonical]
        , (MigrationDefinition
              { migrationDefImports = imps
              , migrationDef =
                  T.concat
                    ["\n", migrationName_, " : ", oldModuleName, ".", nameToText typeNameOld, " -> ", newModuleName, ".", nameToText typeName, "\n"
                    , migrationName_, " ", oldValueRef, " = ", applyOldValueIfNotRecord, migration
                    ]
              }
              & Map.singleton (newModuleNameCanonical, typeNameNew)
            )
            & Map.union subDefs
        )
        & debugMigrationIncludes_ "migrateAliasDefinition" (aliasOld, aliasNew)
  
  
  -- Migrations have 2 levels with regards to tvar resolution:
  --   - resolved gen of migration
  --   - non-resolved gen of subDefs
  -- the individual branches need to be responsible for this
  canToMigration :: Int -> Int -> ModuleName.Canonical -> Interfaces -> RecursionSet -> Can.Type -> Maybe Can.Type -> TvarMap -> TvarMap -> Text -> Migration
  canToMigration oldVersion newVersion scope interfaces recursionSet typeNew typeOldM tvarMapOld tvarMapNew oldValueRef =
    case typeOldM of
      Nothing ->
        unimplemented (T.concat ["canToMigration:noOldType"])
          (T.concat ["There's no old type to migrate, I need you to initialize this `", qualifiedType typeNew, "` value."])
  
      Just typeOld -> do
        if
          (     (isPackageType typeOld)
             && (isPackageType typeNew)
             && (not $ isEquivalentElmType "canToMigration:1" typeOld typeNew))
          || (not $ coreTypesMatch typeOld typeNew)
          then
            unimplemented (T.concat ["canToMigration:noOldType"])
              (T.concat [ "Type changed from `", qualifiedType typeOld, "` to `", qualifiedType typeNew, "`. I need you to write this migration." ])
          else if
               (isPackageType typeOld)
            && (isPackageType typeNew)
            && (isEquivalentAppliedType "canToMigration:2"
                  (Lamdera.Wire3.Helpers.resolveTvar tvarMapOld typeOld)
                  (Lamdera.Wire3.Helpers.resolveTvar tvarMapNew typeNew)
               )
            then noMigration
          else
            canToMigration_ oldVersion newVersion scope interfaces recursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef
  
  
  -- @NOTE should only be called by canToMigration, as the coreTypesMatch guard allows
  -- us to ignore obvious type mismatches in the subsequent migration mapping code below
  canToMigration_ :: Int -> Int -> ModuleName.Canonical -> Interfaces -> RecursionSet -> Can.Type -> Can.Type -> TvarMap -> TvarMap -> Text -> Migration
  canToMigration_ oldVersion newVersion scope interfaces recursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef =
    case typeNew of
      Can.TType moduleName typeName params ->
        typeToMigration oldVersion newVersion scope interfaces recursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef
  
      Can.TAlias moduleName name tvarMap_ aliasType ->
        canAliasToMigration oldVersion newVersion scope interfaces recursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef
  
      Can.TRecord newFields isPartial ->
        recordMigration oldVersion newVersion scope interfaces recursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef
  
      Can.TTuple a1 b1 c1m ->
        debugMigrationIncludes_ "canToMigration_:TTuple" (typeOld, typeNew) $
        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 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 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 wrappedMfn1, subDefs1)
                      (True, False)  -> (handle2 wrappedMfn2, subDefs2)
                      (False, False) -> (handleBoth wrappedMfn1 wrappedMfn2, subDefs1 <> subDefs2)
                in
                xMigrationNested (migration, imps1 <> imps2, migrationDefs)
            in
            case c1m of
              Nothing ->
                migrateTuple
                  (\m_p1      -> T.concat [ "Tuple.mapFirst (", m_p1, ")" ] )
                  (\m_p2      -> T.concat [ "Tuple.mapSecond (", m_p2, ")" ])
                  (\m_p1 m_p2 -> T.concat [ "Tuple.mapBoth (", m_p1, ") (", m_p2, ")" ])
  
              Just c1 ->
                let
                  (MigrationNested mfn3 imps3 subDefs3) =
                    canToMigration oldVersion newVersion scope interfaces recursionSet c1 c2m tvarMapOld tvarMapNew oldValueRef
  
                  applyMigration migration oldValRef =
                    if migration == "" then
                      oldValRef
                    else
                      T.concat [oldValRef, " |> ", migration]
                in
                -- No triple map functions in elm/core so we have to roll our own
                xMigrationNested
                  (
                    [ applyMigration mfn1 "t1"
                    , applyMigration mfn2 "t2"
                    , applyMigration mfn3 "t3"
                    ] & T.intercalate ", "
                    & (\applied ->
                      T.concat ["(\\( t1, t2, t3 ) -> ( ", applied, " ))"]
                    )
                  , Set.unions [imps1,imps2,imps3]
                  , mergeAllSubDefs [subDefs1,subDefs2,subDefs3]
                  )
          _ ->
            -- the coreTypesMatch guard should make this impossible
            error $ "canToMigration_: impossible type mismatch! Please report this gen issue." ++ show (typeOld, typeNew)
  
      Can.TUnit ->
        xMigrationNested ("()", Set.empty, Map.empty)
  
      Can.TVar name ->
        debugMigrationIncludes_ "canToMigration_:TVar" (typeOld, typeNew) $
        xMigrationNested ("migrate_" <> N.toText name, Set.empty, Map.empty)
  
      Can.TLambda _ _ ->
        error "Fatal: impossible function type! Please report this gen issue."
  
  
  canAliasToMigration :: Int -> Int -> ModuleName.Canonical -> Interfaces -> RecursionSet -> Can.Type -> Can.Type -> TvarMap -> TvarMap -> Text -> Migration
  canAliasToMigration oldVersion newVersion scope interfaces recursionSet (typeNew@(Can.TAlias moduleNameNew typeNameNew tvarMapNew aliasTypeNew)) typeOld tvarMapOld tvarMap oldValueRef =
    let
      module_ =
        case moduleNameNew of
          (ModuleName.Canonical (Pkg.Name author pkg) module__) -> module__
  
      newModule = module_
  
      identifier = asIdentifier_ (moduleNameNew, typeNameNew)
    in
    case aliasTypeNew of
      Can.Holey cType ->
        debugMigrationIncludes_ "canAliasToMigration:Holey" (typeOld, typeNew) $
        case typeOld of
          (Can.TAlias moduleNameOld typeNameOld tvarMapOldReplaced aliasTypeOld) ->
            let
              usageParamMigrations :: [Migration]
              usageParamMigrations =
                zip tvarMapOldReplaced tvarMapNew
                  & fmap (\((nOld, paramTypeOld), (nNew, paramTypeNew)) ->
                    canToMigration oldVersion newVersion scope interfaces recursionSet paramTypeNew (Just paramTypeOld) tvarMapOldReplaced tvarMapNew oldValueRef
                  )
  
              usageParamMigrationFns :: [Text]
              usageParamMigrationFns = usageParamMigrations & fmap migrationFn
  
              tvarsNew :: [Text]
              tvarsNew = tvarMapNew & fmap (N.toText . fst)
  
              tvarsOld :: [Text]
              tvarsOld = tvarMapOldReplaced & fmap (N.toText . fst)
  
              (MigrationNested migrationAliasedType imps subDefs) =
                let
                  cTypeOld =
                    case aliasTypeOld of
                      Can.Holey cTypeOld_ -> cTypeOld_
                      Can.Filled cTypeOld_ ->cTypeOld_
                in
                canToMigration oldVersion newVersion moduleNameNew interfaces recursionSet cType (Just cTypeOld) tvarMapOldReplaced tvarMapNew "old"
  
              typeScope = if moduleNameNew == scope then "" else T.concat [nameToText module_, "."]
  
              migrationName :: Text
              migrationName = migrationNameUnderscored newModule oldVersion newVersion typeNameNew
  
              paramMigrationPairs = zip tvarsOld tvarsNew
  
              paramMigrationFnsTypeSig :: [Text]
              paramMigrationFnsTypeSig =
                paramMigrationPairs
                  & fmap (\(oldT, newT) -> T.concat [ "(", oldT, "_old -> ", newT, "_new)" ] )
  
              paramMigrationVars :: Text
              paramMigrationVars =
                paramMigrationPairs
                  & fmap (\(oldT, newT) -> T.concat [ "migrate_", oldT ] )
                  & T.intercalate " "
  
              oldType = T.concat [moduleNameOld & dropCan & N.toText, ".", typeNameOld & N.toText]
              newType = T.concat [newModule & N.toText, ".", typeNameNew & N.toText]
  
              migrationTypeSignature :: Text
              migrationTypeSignature = T.concat
                [ paramMigrationFnsTypeSig & T.intercalate " -> " & suffixIfNonempty " -> "
                , " " , oldType , " "
                , tvarsOld & fmap (\tvar -> T.concat [tvar, "_old"]) & T.intercalate " "
                , " -> " , newType , " "
                , tvarsNew & fmap (\tvar -> T.concat [tvar, "_new"]) & T.intercalate " "
                ]
  
              applyOldValueIfNotRecord m =
                if isRecord cType then m else if m == "" then "old" else T.concat [ "old |> ", m ]
  
              typeDef =
                T.concat
                  [ migrationName, " : ", migrationTypeSignature, "\n"
                  , migrationName, " ", paramMigrationVars, " old = ", applyOldValueIfNotRecord migrationAliasedType
                  ]
  
              emptiesToIdentity v =
                v & List.map (\v_ -> if v_ == "" then "identity" else v_)
            in
              xMigrationNested (
                if length tvarMapNew > 0 then
                  if (usageParamMigrationFns & all (== "")) && isPackageType cType then
                    -- None of the applied params for this type need migrations, and the type is a package type
                    -- so we can skip the migration entirely
                    ""
                  else
                    T.concat ["(", migrationName, " ", usageParamMigrationFns & emptiesToIdentity & parenthesize & T.intercalate " ", ")"]
                else
                  migrationName
                , Set.empty,
                (Map.singleton (moduleNameNew, typeNameNew) $
                  MigrationDefinition
                    { migrationDefImports = Set.fromList [moduleNameNew, moduleNameOld] <> imps
                    , migrationDef = typeDef
                    }
                )
                  & Map.union subDefs
                  & Map.union (mergeAllSubDefs (fmap migrationTopLevelDefs usageParamMigrations))
               )
  
          _ ->
            -- The old type is not an alias, but the new type is. Is this the right treatment?
            unimplemented ""
              ("`" <> N.toText typeNameNew <> "` was a concrete type, but now it's a type alias. I need you to write this migration." )
  
      Can.Filled cType ->
        -- @TODO hypothesis...
        -- If an alias is filled, then it can't have any open holes within it either?
        -- So we can take this opportunity to reset tvars to reduce likeliness of naming conflicts?
        let
          (MigrationNested subt imps subDefs) = canToMigration oldVersion newVersion moduleNameNew interfaces recursionSet cType (Just typeOld) tvarMapOld tvarMapNew oldValueRef
        in
        debugMigrationIncludes_ "canAliasToMigration:Filled" (typeOld, typeNew) $
        xMigrationNested (
          if module_ == (dropCan scope) then
            N.toText typeNameNew
          else if isUserType identifier then
            T.concat [nameToText module_, "."]
          else
            T.concat [nameToText module_, ".", N.toText typeNameNew]
        , imps
        , subDefs
        )
  canAliasToMigration oldVersion newVersion scope interfaces recursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef =
    error $ "canAliasToMigration: impossible alias type! Please report this gen issue: " <> show (typeNew, typeOld)
  
  recordMigration :: Int -> Int -> ModuleName.Canonical -> Interfaces -> RecursionSet -> Can.Type -> Can.Type -> TvarMap -> TvarMap -> Text -> Migration
  recordMigration oldVersion newVersion scope interfaces recursionSet typeNew@(Can.TRecord newFields isPartial) typeOld tvarMapOld tvarMap oldValueRef =
    debugMigrationIncludes_ "recordMigration" (typeOld, typeNew) $
    case isPartial of
      Just whatIsThis ->
        -- @TODO check support for partial records
        xMigrationNested ("ERROR TRecord, please report this!", Set.empty, Map.empty)
      Nothing ->
        let
          fieldMapOld :: Map N.Name Can.FieldType
          fieldMapOld = Lamdera.Wire3.Helpers.extractFieldMap typeOld
  
          fieldMigrations :: [(Text, Migration)]
          fieldMigrations =
            newFields
              & Map.toList
              -- Restore user's field code-ordering to keep types looking familiar
              & List.sortOn (\(fieldName, (Can.FieldType index fieldTypeNew)) -> index)
              & fmap (\(fieldName, (Can.FieldType index fieldTypeNew)) ->
                  case Map.lookup fieldName fieldMapOld of
                    Just (Can.FieldType index_ fieldTypeOld) ->
                      let oldFieldRef = T.concat [oldValueRef, ".", N.toText fieldName]
                      in
                        if isAnonymousRecord fieldTypeNew
                          then
                            let
                              -- In order to deal with anonymous records inline, we have to change
                              -- the name of the value to avoid shadowing the `old.` ref.
                              anonymousValueRef = nextUniqueRef oldValueRef
                              (MigrationNested migration imps subDefs) =
                                canToMigration oldVersion newVersion scope interfaces recursionSet fieldTypeNew (Just (fieldTypeOld)) tvarMapOld tvarMap anonymousValueRef
                            in
                            ( N.toText fieldName
                            , xMigrationNested
                              ( T.concat [ oldFieldRef, "\n            |> (\\", anonymousValueRef, " -> ", migration, ")"], imps, subDefs)
                            )
                          else
                            let
                              (MigrationNested migration imps subDefs) =
                                  canToMigration oldVersion newVersion scope interfaces recursionSet fieldTypeNew (Just (fieldTypeOld)) tvarMapOld tvarMap oldValueRef
                            in
                            if migration == ""
                              then
                                ( N.toText fieldName
                                , xMigrationNested ( T.concat [ oldFieldRef ], Set.empty, Map.empty)
                                )
                              else
                                ( N.toText fieldName
                                , xMigrationNested ( T.concat [ oldFieldRef, " |> ", migration ], imps, subDefs)
                                )
  
                    Nothing ->
                      -- This field did not exist in the old version. We need an init!
                      let (MigrationNested migration imps subDefs) = canToMigration oldVersion newVersion scope interfaces recursionSet fieldTypeNew Nothing tvarMapOld tvarMap oldValueRef
                      in
                      ( N.toText fieldName, xMigrationNested (T.concat["(Unimplemented {- Type `", qualifiedType fieldTypeNew, "` was added in V", show_ newVersion, ". I need you to set a default value. -})"], imps, subDefs) )
              )
              & (\v -> v ++ missingFields)
  
          missingFields :: [(Text, Migration)]
          missingFields =
            fieldMapOld
              & Map.toList
              & filterMap (\(name, (Can.FieldType index fieldTypeOld)) ->
                case Map.lookup name newFields of
                  Just (Can.FieldType index_ _) -> Nothing
                  Nothing ->
                    -- This field name no longer exists in the new fieldMap
                    Just
                      ( N.toText name
                      , unimplemented ("recordMigration:" <> qualifiedTypeName fieldTypeOld)
                        ( T.concat["Field of type `", qualifiedType fieldTypeOld, "` was removed in V", show_ newVersion
                        , ". I need you to do something with the `", oldValueRef, ".", N.toText name, "` value if you wish to keep the data, then remove this line."]
                        )
                      )
              )
  
          fieldsFormatted :: Text
          fieldsFormatted =
            fieldMigrations
              & fmap (\(fieldname, (MigrationNested st imps ft)) -> fieldname <> " = " <> st)
              & T.intercalate "\n    , "
  
        in
        if fieldMigrations & all (\(n, m) -> migrationFn m == (T.concat [oldValueRef, ".", n]))
          then
            -- All fields migrated to the old field without further changes, so this type has no migrations
            xMigrationNested (oldValueRef, Set.empty, Map.empty)
          else
            xMigrationNested
              ( "\n    { " <> fieldsFormatted <> "\n    }"
              , fieldMigrations & fmap (migrationFnImports . snd) & Set.unions
              , fieldMigrations & fmap snd & allSubDefs
              )
  recordMigration oldVersion newVersion scope interfaces recursionSet typeNew typeOld tvarMapOld tvarMap oldValueRef =
    error $ "recordMigration: impossible record type! Please report this gen issue."
  
  
  typeToMigration :: Int -> Int -> ModuleName.Canonical -> Interfaces -> RecursionSet -> Can.Type -> Can.Type -> TvarMap -> TvarMap -> Text -> Migration
  typeToMigration oldVersion newVersion scope interfaces recursionSet_ typeNew@(Can.TType newModuleName name params) typeOld@(Can.TType oldModuleName oldName paramsOld) tvarMapOld tvarMapNew oldValueRef =
    let
      -- @TODO try removing the recursion setting here – it should only be relevant in migrateTypeDef right?
      recursionIdentifier :: (ModuleName.Canonical, N.Name)
      recursionIdentifier = (newModuleName, name)
  
      newRecursionSet :: Set.Set (ModuleName.Canonical, N.Name)
      newRecursionSet = Set.insert recursionIdentifier recursionSet_
  
      identifierNew :: TypeIdentifier
      identifierNew = asIdentifier typeNew
  
      typeName :: Text
      typeName = qualifiedTypeName typeNew
  
      applyMigration p0 p0o migrate_p0 =
        if migrate_p0 == ""
          then ""
          else if isAnonymousRecord p0 then
            let
              -- In order to deal with anonymous records inline, we have to change
              -- the name of the value to avoid shadowing the `old.` ref.
              anonymousValueRef = nextUniqueRef oldValueRef
              (MigrationNested migration _imps _subDefs) =
                canToMigration oldVersion newVersion scope interfaces newRecursionSet p0 (Just (p0o)) tvarMapOld tvarMapNew anonymousValueRef
            in
            T.concat [ "(\\", anonymousValueRef, " -> ", migration, ")"]
          else
            T.concat [ migrate_p0 ]
  
      migrate1ParamCollection :: Migration
      migrate1ParamCollection =
        zipFull paramsOld params & (\p ->
          case p of
            (Just p0o,Just p0):[] ->
              let
                (MigrationNested migrate_p0 imps1 subDefs1) =
                  (canToMigration oldVersion newVersion scope interfaces newRecursionSet p0 (Just p0o) tvarMapOld tvarMapNew "p0")
  
                applied = applyMigration p0 p0o migrate_p0
              in
              if applied == ""
                then xMigrationNested ("", Set.empty, Map.empty)
                -- @TODO this is dubious applying .map indiscriminately
                else xMigrationNested (T.concat [typeName, ".map (", applied, ")"], Set.singleton newModuleName <> imps1, subDefs1)
  
            _ ->
              unimplemented (T.concat ["migrate1ParamCollection"])
                (T.concat [ "Type changed from `", qualifiedType typeOld, "` to `", qualifiedType typeNew, "`. I need you to write this migration." ])
        )
  
      migrate2ParamCollection :: (Text -> Text) -> (Text -> Text) -> (Text -> Text -> Text) -> Migration
      migrate2ParamCollection handle1 handle2 handleBoth =
        zipFull paramsOld params & (\p ->
          case p of
            (Just p0o,Just p0):(Just p1o,Just p1):_ ->
              let
                (MigrationNested migrate_p0 imps0 subDefs0) =
                  (canToMigration oldVersion newVersion scope interfaces newRecursionSet p0 (Just p0o) tvarMapOld tvarMapNew "p0")
                (MigrationNested migrate_p1 imps1 subDefs1) =
                  (canToMigration oldVersion newVersion scope interfaces newRecursionSet p1 (Just p1o) tvarMapOld tvarMapNew "p1")
  
                applied0 = applyMigration p0 p0o migrate_p0
                applied1 = applyMigration p1 p1o migrate_p1
                (migration, migrationDefs) =
                  case (applied0 == "", applied1 == "") of
                    (True, True)   -> ("", Map.empty) -- No migration necessary
                    (False, True)  -> (handle1 applied0, subDefs0)
                    (True, False)  -> (handle2 applied1, subDefs1)
                    (False, False) -> (handleBoth applied0 applied1, subDefs0 <> subDefs1)
              in
              xMigrationNested (migration, Set.singleton newModuleName <> imps0 <> imps1, migrationDefs)
            _ ->
              unimplemented (T.concat ["migrate2ParamCollection"])
                (T.concat [ "Type changed from `", qualifiedType typeOld, "` to `", qualifiedType typeNew, "`. I need you to write this migration." ])
  
        )
    in
    debugMigrationIncludes_ "typeToMigration" (typeOld, typeNew) $
    case identifierNew of
      ("elm", "core", "String", "String") -> noMigration
      ("elm", "core", "Basics", "Int")    -> noMigration
      ("elm", "core", "Basics", "Float")  -> noMigration
      ("elm", "core", "Basics", "Bool")   -> noMigration
      ("elm", "core", "Basics", "Order")  -> noMigration
      ("elm", "core", "Basics", "Never")  -> noMigration
      ("elm", "core", "Char", "Char")     -> noMigration
      ("elm", "core", "Maybe", "Maybe")   -> migrate1ParamCollection
      ("elm", "core", "List", "List")     -> migrate1ParamCollection
      ("elm", "core", "Array", "Array")   -> migrate1ParamCollection
      ("elm", "core", "Set", "Set")       -> migrate1ParamCollection
      ("lamdera", "containers", "SeqSet", "SeqSet") -> migrate1ParamCollection
  
      ("elm", "core", "Result", "Result") -> migrate2ParamCollection
        (\m_p0      -> T.concat [ "Result.mapError (", m_p0, ")" ])
        (\m_p1      -> T.concat [ "Result.map (", m_p1, ")" ])
        (\m_p0 m_p1 -> T.concat [ "Result.mapError (", m_p0, ") >> Result.map (", m_p1, ")" ])
  
      ("elm", "core", "Dict", "Dict")     -> migrate2ParamCollection
        (\m_p0      -> T.concat [ "Dict.toList |> List.map (Tuple.mapFirst ", m_p0, ") |> Dict.fromList" ])
        (\m_p1      -> T.concat [ "Dict.map (\\k -> ", m_p1, ")" ])
        (\m_p0 m_p1 -> T.concat [ "Dict.toList |> List.map (Tuple.mapBoth (", m_p0, ") (", m_p1, ")) |> Dict.fromList" ])
  
      ("lamdera", "containers", "SeqDict", "SeqDict")     -> migrate2ParamCollection
        (\m_p0      -> T.concat [ "SeqDict.toList |> List.map (Tuple.mapFirst ", m_p0, ") |> SeqDict.fromList" ])
        (\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" ])
  
      (author, pkg, module_, typeName_) ->
        if (Set.member recursionIdentifier recursionSet_) then
          handleSeenRecursiveType oldVersion newVersion scope identifierNew interfaces newRecursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef
        else
          -- Anything else must not be a core type, recurse to find it
          case (findTypeDef typeOld interfaces, findTypeDef typeNew interfaces) of
            (Just typeDefOld, Just typeDefNew) ->
              let
                tvarMapOld_ = redoTvarMap tvarMapOld typeOld typeDefOld
                tvarMapNew_ = redoTvarMap tvarMapNew typeNew typeDefNew
              in
              migrateTypeDef typeDefOld typeDefNew oldVersion newVersion interfaces tvarMapOld_ tvarMapNew_ newRecursionSet
  
            (_, Nothing) ->
              unimplemented "typeToMigration" ("I came across a new `" <> qualifiedTypeName typeNew <> "` type but couldn't load the definition. This is probably a hidden package type. I need you to write this migration.")
            (Nothing, _) ->
              unimplemented "typeToMigration" ("I came across an old `" <> qualifiedTypeName typeOld <> "` type but couldn't load the definition. This is probably a hidden package type. I need you to write this migration.")
            context -> error $ "typeToMigration: impossible! Please report this gen issue: " <> show context
  typeToMigration oldVersion newVersion scope interfaces recursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef =
    error $ "typeToMigration: impossible! Please report this gen issue: " <> show (typeNew, typeOld)
  
  migrateTypeDef typeOld typeNew oldVersion newVersion interfaces tvarMapOld tvarMapNew recursionSet =
    case (typeOld, typeNew) of
      (Alias mOld typeNameOld aliasOld, Alias mNew typeNameNew aliasNew) ->
        let
          recursionIdentifier :: (ModuleName.Canonical, N.Name)
          recursionIdentifier = (mNew, typeNameNew)
  
          newRecursionSet :: RecursionSet
          newRecursionSet = Set.insert recursionIdentifier recursionSet
  
          identifier :: TypeIdentifier
          identifier = asIdentifier_ recursionIdentifier
        in
        migrateAliasDefinition oldVersion newVersion mOld mNew identifier typeNameOld typeNameNew interfaces newRecursionSet aliasOld aliasNew "old" tvarMapOld tvarMapNew
        & debugMigrationIncludes_ "migrateTypeDef:Alias" (typeOld, typeNew)
  
      (typeDefOld@(Union mOld typeNameOld unionOld), Union mNew typeNameNew unionNew) ->
        let
          recursionIdentifier :: (ModuleName.Canonical, N.Name)
          recursionIdentifier = (mNew, typeNameNew)
  
          newRecursionSet :: RecursionSet
          newRecursionSet = Set.insert recursionIdentifier recursionSet
  
          identifier :: TypeIdentifier
          identifier = asIdentifier_ recursionIdentifier
        in
        -- @TODO use unionOld instead of typeDefOld
        -- @TODO pass params
        migrateUnionDefinition typeDefOld oldVersion newVersion mNew identifier typeNameNew interfaces newRecursionSet tvarMapOld tvarMapNew unionNew
          & debugMigrationIncludes_ "migrateTypeDef:Union" (typeOld, typeNew)
  
      -- @ADVANCED handle case where user is aliasing a custom type?
  
      (Union mOld typeNameOld unionOld, Alias mNew typeNameNew aliasNew) ->
        unimplemented "" ("`" <> N.toText typeNameNew <> "` was a custom type, but now it's a type alias. I need you to write this migration.")
  
      (Alias mOld typeNameOld aliasOld, Union mNew typeNameNew unionNew) ->
        unimplemented "" ("`" <> N.toText typeNameOld <> "` was a type alias, but now it's a custom type. I need you to write this migration.")
  
  
  redoTvarMap tvarMap tipe typeDef =
    -- @TODO need to resolve the tvarMap here for things that have become concrete
    let
      names =
        case typeDef of
          (Alias moduleNameOld typeNameOld (Can.Alias tvars tipe_)) -> tvars
          (Union moduleNameOld typeNameOld union) -> Can._u_vars union
  
      newTvarMap =
        case tipe of
          Can.TType moduleName name tvars ->
            zip names tvars
          Can.TAlias moduleName name tvarMap_ aliasType ->
            -- uhhhhh?? this can't be right.
            -- debugHaskellPass "redoTvarMap_alias" (tipe, typeDef) $
            tvarMap_
          _ ->
            error $ "redoTvarMap: impossible tipe! Please report this gen issue: " <> show tipe
    in
    newTvarMap
  
  
  migrateTvars oldVersion newVersion scope interfaces recursionSet tvarMapOld tvarMapNew tvarPairs =
    let
      tvarMigrations :: [Migration]
      tvarMigrations =
        tvarPairs
          & imap (\i (paramOld, paramNew) ->
            let
              isAnonymous = isAnonymousRecord paramNew
              anonymousValueRef = "rec"
              valueRef = if isAnonymous then anonymousValueRef else ("p" <> show_ i)
              ft@(MigrationNested fn imps subDefs) =
                canToMigration oldVersion newVersion scope interfaces recursionSet paramNew (Just paramOld) tvarMapOld tvarMapNew valueRef
            in
            if fn == "" then
              -- Because paramaterised migrations are passed into functions that expect `v1 -> v2` functions, we
              -- need to pass in a function even if there is no migration necessary, i.e. `String -> String`.
              ft { migrationFn = "identity" }
            else if isAnonymous then
              ft { migrationFn = T.concat [ "(\\", anonymousValueRef, " -> ", fn, ")" ] }
            else
              ft
          )
    in
    tvarMigrations
  
  
  -- Prevents us from recursing infinitely on a recursive type, but still includes
  -- any unique tvars that might have been used in this specific invocation
  handleSeenRecursiveType :: Int -> Int -> ModuleName.Canonical -> TypeIdentifier -> Interfaces -> RecursionSet -> Can.Type -> Can.Type -> TvarMap -> TvarMap -> Text -> Migration
  handleSeenRecursiveType oldVersion newVersion scope identifier@(author, pkg, newModule, _) interfaces recursionSet typeNew@(Can.TType moduleName name tvarsNew) typeOld@(Can.TType oldModuleName oldName tvarsOld) tvarMapOld tvarMapNew oldValueRef =
    let
        tvarPairs = zip tvarsOld tvarsNew
        tvarMigrations = migrateTvars oldVersion newVersion scope interfaces recursionSet tvarMapOld tvarMapNew tvarPairs
  
        tvarMigrationTextsCombined :: Text
        tvarMigrationTextsCombined = tvarMigrations & fmap migrationFn & parenthesize & T.intercalate " "
  
        subDefs :: MigrationDefinitions
        subDefs = tvarMigrations & fmap migrationTopLevelDefs & mergeAllSubDefs
  
        migrationName :: Text
        migrationName = migrationNameUnderscored newModule oldVersion newVersion name
      in
      xMigrationNested (
        if length tvarsNew > 0
          then "(" <> migrationName <> " " <> tvarMigrationTextsCombined <> ")"
          else migrationName
      , Set.empty
      , subDefs
      )
      & debugMigrationIncludes_ "handleSeenRecursiveType" (typeOld, typeNew)
  handleSeenRecursiveType oldVersion newVersion scope identifier@(author, pkg, newModule, _) interfaces recursionSet typeNew typeOld tvarMapOld tvarMapNew oldValueRef =
    error $ "handleSeenRecursiveType: impossible recursive type! Please report this gen issue: " <> show (typeNew, typeOld)
  