Add configuration for whether to vacuum after migrating (#4033)

* Add configuration for whether to vacuum after migrating

* Ormolu everything

parser-typechecker/src/Unison/Codebase/Init.hs

@@ -11,6 +11,7 @@ module Unison.Codebase.Init
     SpecifiedCodebase (..),
     MigrationStrategy (..),
     BackupStrategy (..),
+    VacuumStrategy (..),
     Pretty,
     createCodebase,
     initCodebaseAndExit,
@@ -57,11 +58,19 @@ data BackupStrategy
     NoBackup
   deriving stock (Show, Eq, Ord)
 
+data VacuumStrategy
+  = -- Vacuum after migrating. Takes a bit longer but keeps the codebase clean and maybe reduces size.
+    Vacuum
+  | -- Don't vacuum after migrating. Vacuuming is time consuming on large codebases,
+    -- so we don't want to do it during server migrations.
+    NoVacuum
+  deriving stock (Show, Eq, Ord)
+
 data MigrationStrategy
   = -- | Perform a migration immediately if one is required.
-    MigrateAutomatically BackupStrategy
+    MigrateAutomatically BackupStrategy VacuumStrategy
   | -- | Prompt the user that a migration is about to occur, continue after acknownledgment
-    MigrateAfterPrompt BackupStrategy
+    MigrateAfterPrompt BackupStrategy VacuumStrategy
   | -- | Triggers an 'OpenCodebaseRequiresMigration' error instead of migrating
     DontMigrate
   deriving stock (Show, Eq, Ord)

parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs

@@ -11,6 +11,7 @@ module Unison.Codebase.SqliteCodebase
     Unison.Codebase.SqliteCodebase.initWithSetup,
     MigrationStrategy (..),
     BackupStrategy (..),
+    VacuumStrategy (..),
     CodebaseLockOption (..),
     copyCodebase,
   )
@@ -49,7 +50,7 @@ import Unison.Codebase.Editor.RemoteRepo
     writeToReadGit,
   )
 import Unison.Codebase.GitError qualified as GitError
-import Unison.Codebase.Init (BackupStrategy (..), CodebaseLockOption (..), MigrationStrategy (..))
+import Unison.Codebase.Init (BackupStrategy (..), CodebaseLockOption (..), MigrationStrategy (..), VacuumStrategy (..))
 import Unison.Codebase.Init qualified as Codebase
 import Unison.Codebase.Init.CreateCodebaseError qualified as Codebase1
 import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (..))
@@ -227,12 +228,12 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action
       Migrations.CodebaseRequiresMigration fromSv toSv ->
         case migrationStrategy of
           DontMigrate -> pure $ Left (OpenCodebaseRequiresMigration fromSv toSv)
-          MigrateAfterPrompt backupStrategy -> do
+          MigrateAfterPrompt backupStrategy vacuumStrategy -> do
             let shouldPrompt = True
-            Migrations.ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer shouldPrompt backupStrategy conn
-          MigrateAutomatically backupStrategy -> do
+            Migrations.ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer shouldPrompt backupStrategy vacuumStrategy conn
+          MigrateAutomatically backupStrategy vacuumStrategy -> do
             let shouldPrompt = False
-            Migrations.ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer shouldPrompt backupStrategy conn
+            Migrations.ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer shouldPrompt backupStrategy vacuumStrategy conn
 
   case result of
     Left err -> pure $ Left err
@@ -595,7 +596,7 @@ viewRemoteBranch' ReadGitRemoteNamespace {repo, sch, path} gitBranchBehavior act
           then throwIO (C.GitSqliteCodebaseError (GitError.NoDatabaseFile repo remotePath))
           else throwIO exception
 
-      result <- sqliteCodebase "viewRemoteBranch.gitCache" remotePath Remote DoLock (MigrateAfterPrompt Codebase.Backup) \codebase -> do
+      result <- sqliteCodebase "viewRemoteBranch.gitCache" remotePath Remote DoLock (MigrateAfterPrompt Codebase.Backup Codebase.Vacuum) \codebase -> do
         -- try to load the requested branch from it
         branch <- time "Git fetch (sch)" $ case sch of
           -- no sub-branch was specified, so use the root.
@@ -645,7 +646,7 @@ pushGitBranch srcConn repo (PushGitBranchOpts behavior _syncMode) action = Unlif
   -- set up the cache dir
   throwEitherMWith C.GitProtocolError . withRepo readRepo Git.CreateBranchIfMissing $ \pushStaging -> do
     newBranchOrErr <- throwEitherMWith (C.GitSqliteCodebaseError . C.gitErrorFromOpenCodebaseError (Git.gitDirToPath pushStaging) readRepo)
-      . withOpenOrCreateCodebase (pure ()) "push.dest" (Git.gitDirToPath pushStaging) Remote DoLock (MigrateAfterPrompt Codebase.Backup)
+      . withOpenOrCreateCodebase (pure ()) "push.dest" (Git.gitDirToPath pushStaging) Remote DoLock (MigrateAfterPrompt Codebase.Backup Codebase.Vacuum)
       $ \(codebaseStatus, destCodebase) -> do
         currentRootBranch <-
           Codebase1.runTransaction destCodebase CodebaseOps.getRootBranchExists >>= \case

parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs

@@ -15,7 +15,7 @@ import U.Codebase.Reference qualified as C.Reference
 import U.Codebase.Sqlite.DbId (SchemaVersion (..))
 import U.Codebase.Sqlite.Queries qualified as Q
 import Unison.Codebase (CodebasePath)
-import Unison.Codebase.Init (BackupStrategy (..))
+import Unison.Codebase.Init (BackupStrategy (..), VacuumStrategy (..))
 import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (OpenCodebaseUnknownSchemaVersion))
 import Unison.Codebase.Init.OpenCodebaseError qualified as Codebase
 import Unison.Codebase.IntegrityCheck (IntegrityResult (..), integrityCheckAllBranches, integrityCheckAllCausals, prettyPrintIntegrityErrors)
@@ -99,9 +99,10 @@ ensureCodebaseIsUpToDate ::
   TVar (Map Hash Ops2.DeclBufferEntry) ->
   Bool ->
   BackupStrategy ->
+  VacuumStrategy ->
   Sqlite.Connection ->
   m (Either Codebase.OpenCodebaseError ())
-ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer shouldPrompt backupStrategy conn =
+ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer shouldPrompt backupStrategy vacuumStrategy conn =
   (liftIO . UnliftIO.try) do
     regionVar <- newEmptyMVar
     let finalizeRegion :: IO ()
@@ -175,7 +176,9 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh
           region <- readMVar regionVar
           -- Vacuum once now that any migrations have taken place.
           Region.setConsoleRegion region ("✅ All good, cleaning up..." :: Text)
-          _success <- Sqlite.Connection.vacuum conn
+          case vacuumStrategy of
+            Vacuum -> void $ Sqlite.Connection.vacuum conn
+            NoVacuum -> pure ()
           Region.setConsoleRegion region ("🏁 Migrations complete 🏁" :: Text)
 
 -- | If we need to make a backup,  then copy the sqlite database to a new file with a unique name based on current time.

unison-cli/unison/Main.hs

@@ -117,7 +117,7 @@ main = withCP65001 . runInUnboundThread . Ki.scoped $ \scope -> do
                 ]
             )
         Run (RunFromSymbol mainName) args -> do
-          getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup) \(_, _, theCodebase) -> do
+          getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do
             RTI.withRuntime False RTI.OneOff Version.gitDescribeWithDate \runtime -> do
               withArgs args (execute theCodebase runtime mainName) >>= \case
                 Left err -> exitError err
@@ -129,7 +129,7 @@ main = withCP65001 . runInUnboundThread . Ki.scoped $ \scope -> do
               case e of
                 Left _ -> exitError "I couldn't find that file or it is for some reason unreadable."
                 Right contents -> do
-                  getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup) \(initRes, _, theCodebase) -> do
+                  getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do
                     withRuntimes RTI.OneOff \(rt, sbrt) -> do
                       let fileEvent = Input.UnisonFileChanged (Text.pack file) contents
                       let noOpRootNotifier _ = pure ()
@@ -155,7 +155,7 @@ main = withCP65001 . runInUnboundThread . Ki.scoped $ \scope -> do
           case e of
             Left _ -> exitError "I had trouble reading this input."
             Right contents -> do
-              getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup) \(initRes, _, theCodebase) -> do
+              getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do
                 withRuntimes RTI.OneOff \(rt, sbrt) -> do
                   let fileEvent = Input.UnisonFileChanged (Text.pack "<standard input>") contents
                   let noOpRootNotifier _ = pure ()
@@ -246,7 +246,7 @@ main = withCP65001 . runInUnboundThread . Ki.scoped $ \scope -> do
             Nothing -> action
             Just fp -> recordRtsStats fp action
         Launch isHeadless codebaseServerOpts downloadBase mayStartingPath shouldWatchFiles -> do
-          getCodebaseOrExit mCodePathOption (SC.MigrateAfterPrompt SC.Backup) \(initRes, _, theCodebase) -> do
+          getCodebaseOrExit mCodePathOption (SC.MigrateAfterPrompt SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do
             withRuntimes RTI.Persistent \(runtime, sbRuntime) -> do
               rootVar <- newEmptyTMVarIO
               pathVar <- newTVarIO initialPath
@@ -341,7 +341,7 @@ prepareTranscriptDir shouldFork mCodePathOption shouldSaveCodebase = do
   case shouldFork of
     UseFork -> do
       -- A forked codebase does not need to Create a codebase, because it already exists
-      getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup) $ const (pure ())
+      getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) $ const (pure ())
       path <- Codebase.getCodebaseDir (fmap codebasePathOptionToPath mCodePathOption)
       PT.putPrettyLn $
         P.lines
@@ -365,7 +365,7 @@ runTranscripts' progName mcodepath transcriptDir markdownFiles = do
   currentDir <- getCurrentDirectory
   configFilePath <- getConfigFilePath mcodepath
   -- We don't need to create a codebase through `getCodebaseOrExit` as we've already done so previously.
-  and <$> getCodebaseOrExit (Just (DontCreateCodebaseWhenMissing transcriptDir)) (SC.MigrateAutomatically SC.Backup) \(_, codebasePath, theCodebase) -> do
+  and <$> getCodebaseOrExit (Just (DontCreateCodebaseWhenMissing transcriptDir)) (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, codebasePath, theCodebase) -> do
     TR.withTranscriptRunner Version.gitDescribeWithDate (Just configFilePath) $ \runTranscript -> do
       for markdownFiles $ \(MarkdownFile fileName) -> do
         transcriptSrc <- readUtf8 fileName