convert v3 branch to v1 branch

parser-typechecker/src/Unison/Codebase.hs

@@ -37,6 +37,7 @@ module Unison.Codebase
     SqliteCodebase.Operations.branchExists,
     getBranchForHash,
     expectBranchForHash,
+    expectBranchForHashIO,
     putBranch,
     SqliteCodebase.Operations.causalHashesByPrefix,
     lca,
@@ -244,7 +245,7 @@ getShallowBranchAtPath path mayBranch = do
           getShallowBranchAtPath p (Just childBranch)
 
 -- | Get a branch from the codebase.
-getBranchForHash :: (Monad m) => Codebase m v a -> CausalHash -> m (Maybe (Branch m))
+getBranchForHash :: MonadIO m => Codebase m v a -> CausalHash -> m (Maybe (Branch m))
 getBranchForHash codebase h =
   -- Attempt to find the Branch in the current codebase cache and root up to 3 levels deep
   -- If not found, attempt to find it in the Codebase (sqlite)
@@ -259,15 +260,21 @@ getBranchForHash codebase h =
       find rb = List.find headHashEq (nestedChildrenForDepth 3 rb)
    in do
         rootBranch <- getRootBranch codebase
-        maybe (getBranchForHashImpl codebase h) (pure . Just) (find rootBranch)
+        maybe (fmap (Branch.transform (runTransaction codebase)) <$> runTransaction codebase (getBranchForHashImpl codebase h)) (pure . Just) (find rootBranch)
 
--- | Like 'getBranchForHash', but for when the hash is known to be in the codebase.
-expectBranchForHash :: (Monad m) => Codebase m v a -> CausalHash -> m (Branch m)
+expectBranchForHash :: Codebase m v a -> CausalHash -> Sqlite.Transaction (Branch Sqlite.Transaction)
 expectBranchForHash codebase hash =
-  getBranchForHash codebase hash >>= \case
+  getBranchForHashImpl codebase hash >>= \case
     Just branch -> pure branch
     Nothing -> error $ reportBug "E412939" ("expectBranchForHash: " ++ show hash ++ " not found in codebase")
 
+-- | Like 'getBranchForHash', but for when the hash is known to be in the codebase.
+expectBranchForHashIO :: MonadIO m => Codebase m v a -> CausalHash -> m (Branch m)
+expectBranchForHashIO codebase hash =
+  getBranchForHash codebase hash >>= \case
+    Just branch -> pure branch
+    Nothing -> error $ reportBug "E412939" ("expectBranchForHashIO: " ++ show hash ++ " not found in codebase")
+
 -- | Get the metadata attached to the term at a given path and name relative to the given branch.
 termMetadata ::
   -- | The branch to search inside. Use the current root if 'Nothing'.
@@ -502,9 +509,9 @@ importRemoteBranch ::
   SyncMode ->
   Preprocessing m ->
   m (Either GitError (Branch m))
-importRemoteBranch codebase ns mode preprocess = runExceptT $ do
+importRemoteBranch codebase ns mode preprocess = runExceptT do
   branchHash <- ExceptT . viewRemoteBranch' codebase ns Git.RequireExistingBranch $ \(branch, cacheDir) -> do
-    withStatus "Importing downloaded files into local codebase..." $ do
+    withStatus "Importing downloaded files into local codebase..." do
       processedBranch <- preprocessOp branch
       time "SyncFromDirectory" $ do
         syncFromDirectory codebase cacheDir mode processedBranch

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

@@ -316,9 +316,9 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action
 
             -- if this blows up on cromulent hashes, then switch from `hashToHashId`
             -- to one that returns Maybe.
-            getBranchForHash :: CausalHash -> m (Maybe (Branch m))
-            getBranchForHash h =
-              fmap (Branch.transform runTransaction) <$> runTransaction (CodebaseOps.getBranchForHash branchCache getDeclType h)
+            getBranchForHash :: CausalHash -> Sqlite.Transaction (Maybe (Branch Sqlite.Transaction))
+            getBranchForHash =
+              CodebaseOps.getBranchForHash branchCache getDeclType
 
             putBranch :: Branch m -> m ()
             putBranch branch =
@@ -607,7 +607,7 @@ viewRemoteBranch' ReadGitRemoteNamespace {repo, sch, path} gitBranchBehavior act
             case toList branchCompletions of
               [] -> throwIO . C.GitCodebaseError $ GitError.NoRemoteNamespaceWithHash repo sch
               [h] ->
-                (Codebase1.getBranchForHash codebase h) >>= \case
+                Codebase1.getBranchForHash codebase h >>= \case
                   Just b -> pure b
                   Nothing -> throwIO . C.GitCodebaseError $ GitError.NoRemoteNamespaceWithHash repo sch
               _ -> throwIO . C.GitCodebaseError $ GitError.RemoteNamespaceHashAmbiguous repo sch branchCompletions

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

@@ -79,7 +79,7 @@ data Codebase m v a = Codebase
       Text -> -- Reason for the change, will be recorded in the reflog
       Branch m ->
       m (),
-    getBranchForHashImpl :: CausalHash -> m (Maybe (Branch m)),
+    getBranchForHashImpl :: CausalHash -> Sqlite.Transaction (Maybe (Branch Sqlite.Transaction)),
     -- | Put a branch into the codebase, which includes its children, its patches, and the branch itself, if they don't
     -- already exist.
     --

unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs

@@ -75,10 +75,10 @@ import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch qualified as V1 (Branch, Branch0)
 import Unison.Codebase.Branch qualified as V1.Branch
 import Unison.Codebase.Causal qualified as V1 (Causal)
-import Unison.Codebase.Editor.Output qualified as Output
-import Unison.Codebase.Metadata qualified as V1.Metadata
 import Unison.Codebase.Causal qualified as V1.Causal
 import Unison.Codebase.Causal.Type qualified as V1.Causal
+import Unison.Codebase.Editor.Output qualified as Output
+import Unison.Codebase.Metadata qualified as V1.Metadata
 import Unison.Codebase.Path (Path')
 import Unison.Codebase.Path qualified as Path
 import Unison.ConstructorReference (ConstructorReference, ConstructorReferenceId, GConstructorReference (..))
@@ -333,14 +333,15 @@ handleMerge bobBranchName = do
           let unconflictedBranch :: BranchV3 Transaction
               unconflictedBranch =
                 let unflattenedTree =
-                        Merge.mergeNamespaceTrees
+                      Merge.mergeNamespaceTrees
                         (\(aliceDefns, aliceCausal) -> (aliceDefns, Left aliceCausal))
                         (\(bobDefns, bobCausal) -> (bobDefns, Left bobCausal))
-                        (\(aliceDefns, aliceCausal) (bobDefns, bobCausal) ->
-                           -- We should maybe say that a left-biased
-                           -- union is fine here because we are merging
-                           -- unconflicted things so there is no bias
-                           (aliceDefns <> bobDefns, Right (aliceCausal, bobCausal)))
+                        ( \(aliceDefns, aliceCausal) (bobDefns, bobCausal) ->
+                            -- We should maybe say that a left-biased
+                            -- union is fine here because we are merging
+                            -- unconflicted things so there is no bias
+                            (aliceDefns <> bobDefns, Right (aliceCausal, bobCausal))
+                        )
                         (makeBigTree aliceUnconflicted aliceCausalTree)
                         (makeBigTree bobUnconflicted bobCausalTree)
                     makeBigTree defns causals =
@@ -352,6 +353,8 @@ handleMerge bobBranchName = do
                         causals
                  in namespaceToBranchV3 unflattenedTree
 
+          unconflictedV1Branch <- loadV3BranchAsV1Branch0 loadDeclType (Codebase.expectBranchForHash codebase) unconflictedBranch
+
           -- If there are conflicts, then create a MergeOutput
           mergeOutput <- wundefined "create MergeOutput"
           wundefined "dump MergeOutput to scratchfile" mergeOutput

unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs

@@ -300,7 +300,7 @@ cloneInto localProjectBranch remoteProjectBranch = do
   -- Manipulate the root namespace and cd
   Cli.Env {codebase} <- ask
   let branchHead = hash32ToCausalHash (Share.API.hashJWTHash remoteBranchHeadJwt)
-  theBranch <- liftIO (Codebase.expectBranchForHash codebase branchHead)
+  theBranch <- liftIO (Codebase.expectBranchForHashIO codebase branchHead)
   let path = projectBranchPath (over #project fst localProjectAndBranch)
   Cli.updateAt ("clone " <> into @Text remoteProjectBranchNames) path (const theBranch)
   Cli.cd path

unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs

@@ -120,7 +120,7 @@ projectCreate tryDownloadingBase maybeProjectName = do
             Cli.Env {codebase} <- ask
             baseLatestReleaseBranchObject <-
               liftIO $
-                Codebase.expectBranchForHash
+                Codebase.expectBranchForHashIO
                   codebase
                   (Sync.Common.hash32ToCausalHash (Share.API.hashJWTHash (baseLatestReleaseBranch ^. #branchHead)))
             pure (Just baseLatestReleaseBranchObject)

unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs

@@ -231,7 +231,7 @@ loadRemoteNamespaceIntoMemory syncMode pullMode remoteNamespace = do
     ReadShare'ProjectBranch remoteBranch -> do
       projectBranchCausalHashJWT <- downloadShareProjectBranch (pullMode == Input.PullWithoutHistory) remoteBranch
       let causalHash = Common.hash32ToCausalHash (Share.hashJWTHash projectBranchCausalHashJWT)
-      liftIO (Codebase.expectBranchForHash codebase causalHash)
+      liftIO (Codebase.expectBranchForHashIO codebase causalHash)
 
 -- | @downloadShareProjectBranch branch@ downloads the given branch.
 downloadShareProjectBranch :: HasCallStack => Bool -> Share.RemoteProjectBranch -> Cli HashJWT
@@ -276,7 +276,7 @@ loadShareLooseCodeIntoMemory rrn@(ReadShareLooseCode {server, repo, path}) = do
       numDownloaded <- liftIO getNumDownloaded
       pure (causalHash, numDownloaded)
   Cli.respond (Output.DownloadedEntities numDownloaded)
-  liftIO (Codebase.expectBranchForHash codebase causalHash)
+  liftIO (Codebase.expectBranchForHashIO codebase causalHash)
 
 -- Provide the given action a callback that display to the terminal.
 withEntitiesDownloadedProgressCallback :: ((Int -> IO (), IO Int) -> IO a) -> IO a

unison-share-api/src/Unison/Server/Backend.hs

@@ -1172,7 +1172,7 @@ scopedNamesForBranchHash codebase mbh path = do
       pure (ScopedNames.parseNames scopedNames, ScopedNames.namesAtPath scopedNames)
 
 resolveCausalHash ::
-  (Monad m) => Maybe CausalHash -> Codebase m v a -> Backend m (Branch m)
+  (MonadIO m) => Maybe CausalHash -> Codebase m v a -> Backend m (Branch m)
 resolveCausalHash h codebase = case h of
   Nothing -> lift (Codebase.getRootBranch codebase)
   Just bhash -> do