From ef1d5ed1ed087ee50fd190d7ecfc13a527b3af5f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 May 2023 14:32:45 -0600 Subject: [PATCH] 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 | 13 +++++++++++-- .../src/Unison/Codebase/SqliteCodebase.hs | 15 ++++++++------- .../Unison/Codebase/SqliteCodebase/Migrations.hs | 9 ++++++--- unison-cli/unison/Main.hs | 12 ++++++------ 4 files changed, 31 insertions(+), 18 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Init.hs b/parser-typechecker/src/Unison/Codebase/Init.hs index c7173e771..79d291ecc 100644 --- a/parser-typechecker/src/Unison/Codebase/Init.hs +++ b/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) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs index 0d254e791..59250dc25 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs +++ b/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 diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 9585dbcc9..0911fd6b3 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/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. diff --git a/unison-cli/unison/Main.hs b/unison-cli/unison/Main.hs index b53f2b2a4..c79d1f78c 100644 --- a/unison-cli/unison/Main.hs +++ b/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 "") 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