Merge pull request #4966 from unisonweb/topic/merge5

codebase2/codebase/package.yaml

@@ -21,8 +21,33 @@ library:
       other-modules: Paths_unison_codebase
 
 default-extensions:
+  - BangPatterns
   - BlockArguments
+  - DeriveAnyClass
+  - DeriveFunctor
+  - DeriveGeneric
+  - DeriveTraversable
   - DerivingStrategies
+  - DerivingVia
+  - DoAndIfThenElse
+  - DuplicateRecordFields
+  - FlexibleContexts
+  - FlexibleInstances
+  - GeneralizedNewtypeDeriving
+  - ImportQualifiedPost
   - LambdaCase
+  - MultiParamTypeClasses
+  - NamedFieldPuns
+  - OverloadedLabels
+  - OverloadedRecordDot
+  - OverloadedStrings
+  - PatternSynonyms
+  - RankNTypes
+  - ScopedTypeVariables
+  - StandaloneDeriving
+  - TupleSections
+  - TypeApplications
+  - TypeFamilies
+  - ViewPatterns
 
 language: GHC2021

codebase2/codebase/unison-codebase.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -31,9 +31,34 @@ library
   hs-source-dirs:
       ./
   default-extensions:
+      BangPatterns
       BlockArguments
+      DeriveAnyClass
+      DeriveFunctor
+      DeriveGeneric
+      DeriveTraversable
       DerivingStrategies
+      DerivingVia
+      DoAndIfThenElse
+      DuplicateRecordFields
+      FlexibleContexts
+      FlexibleInstances
+      GeneralizedNewtypeDeriving
+      ImportQualifiedPost
       LambdaCase
+      MultiParamTypeClasses
+      NamedFieldPuns
+      OverloadedLabels
+      OverloadedRecordDot
+      OverloadedStrings
+      PatternSynonyms
+      RankNTypes
+      ScopedTypeVariables
+      StandaloneDeriving
+      TupleSections
+      TypeApplications
+      TypeFamilies
+      ViewPatterns
   build-depends:
       base
     , containers

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

@@ -476,13 +476,18 @@ cons :: (Applicative m) => Branch0 m -> Branch m -> Branch m
 cons = step . const
 
 -- | Construct a two-parent merge node.
-mergeNode :: forall m. Applicative m => Branch0 m -> Branch m -> Branch m -> Branch m
+mergeNode ::
+  forall m.
+  Applicative m =>
+  Branch0 m ->
+  (CausalHash, m (Branch m)) ->
+  (CausalHash, m (Branch m)) ->
+  Branch m
 mergeNode child parent1 parent2 =
   Branch (Causal.mergeNode child (Map.fromList [f parent1, f parent2]))
   where
-    f :: Branch m -> (CausalHash, m (Causal m (Branch0 m)))
-    f parent =
-      (headHash parent, pure (_history parent))
+    f (hash, getBranch) =
+      (hash, _history <$> getBranch)
 
 isOne :: Branch m -> Bool
 isOne (Branch Causal.One {}) = True
@@ -606,20 +611,17 @@ modifyAt path f = runIdentity . modifyAtM path (pure . f)
 -- Because it's a `Branch`, it overwrites the history at `path`.
 modifyAtM ::
   forall n m.
-  (Functor n) =>
-  (Applicative m) => -- because `Causal.cons` uses `pure`
+  (Functor n, Applicative m) =>
   Path ->
   (Branch m -> n (Branch m)) ->
   Branch m ->
   n (Branch m)
 modifyAtM path f b = case Path.uncons path of
   Nothing -> f b
-  Just (seg, path) -> do
-    -- Functor
+  Just (seg, path) ->
     let child = getChildBranch seg (head b)
-    child' <- modifyAtM path f child
-    -- step the branch by updating its children according to fixup
-    pure $ step (setChildBranch seg child') b
+     in -- step the branch by updating its children according to fixup
+        (\child' -> step (setChildBranch seg child') b) <$> modifyAtM path f child
 
 -- | Perform updates over many locations within a branch by batching up operations on
 -- sub-branches as much as possible without affecting semantics.

parser-typechecker/src/Unison/Codebase/Editor/Git.hs

@@ -144,7 +144,7 @@ withRepo repo@(ReadGitRepo {url = uri, ref = mayGitRef}) branchBehavior action =
   throwExceptT $ checkForGit
   gitCachePath <- gitCacheDir uri
   -- Ensure we have the main branch in the cache dir no matter what
-  throwExceptT $ cloneIfMissing repo {ref = Nothing} gitCachePath
+  _ :: GitRepo <- throwExceptT $ cloneIfMissing repo {ref = Nothing} gitCachePath
   let gitCacheRepo = Bare gitCachePath
   gitRef <- case mayGitRef of
     Nothing -> fromMaybe "main" <$> getDefaultBranch gitCacheRepo

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

@@ -662,7 +662,7 @@ pushGitBranch srcConn repo behavior action = UnliftIO.try do
             C.withConnection destCodebase \destConn ->
               doSync codebaseStatus destConn newBranch
             pure (Right newBranch)
-    for newBranchOrErr $ push pushStaging repo
+    for_ newBranchOrErr $ push pushStaging repo
     pure newBranchOrErr
   where
     readRepo :: ReadGitRepo

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

@@ -6,6 +6,7 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema6To7 (migrateSchem
 
 import Control.Monad.Except
 import Control.Monad.State
+import U.Codebase.Branch.Type (NamespaceStats)
 import U.Codebase.Sqlite.DbId qualified as DB
 import U.Codebase.Sqlite.DbId qualified as Db
 import U.Codebase.Sqlite.Operations qualified as Ops
@@ -50,7 +51,7 @@ addStatsForBranch :: DB.BranchObjectId -> Sqlite.Transaction (Sync.TrySyncResult
 addStatsForBranch boId = do
   bhId <- Db.BranchHashId <$> Q.expectPrimaryHashIdForObject (Db.unBranchObjectId boId)
   -- "expectNamespaceStatsByHashId" computes stats if they are missing.
-  Ops.expectNamespaceStatsByHashId bhId
+  _ :: NamespaceStats <- Ops.expectNamespaceStatsByHashId bhId
   pure Sync.Done
 
 debugLog :: String -> Sqlite.Transaction ()

parser-typechecker/src/Unison/Runtime/Interface.hs

@@ -929,7 +929,7 @@ nativeCompileCodes executable codes base path = do
         BS.hPut pin . runPutS . putWord32be . fromIntegral $ BS.length bytes
         BS.hPut pin bytes
         UnliftIO.hClose pin
-        waitForProcess ph
+        _ <- waitForProcess ph
         pure ()
       callout _ _ _ _ = fail "withCreateProcess didn't provide handles"
       ucrError (e :: IOException) =

parser-typechecker/src/Unison/Syntax/TermParser.hs

@@ -141,11 +141,11 @@ link :: (Monad m, Var v) => TermP v m
 link = termLink <|> typeLink
   where
     typeLink = do
-      P.try (reserved "typeLink") -- type opens a block, gotta use something else
+      _ <- P.try (reserved "typeLink") -- type opens a block, gotta use something else
       tok <- typeLink'
       pure $ Term.typeLink (ann tok) (L.payload tok)
     termLink = do
-      P.try (reserved "termLink")
+      _ <- P.try (reserved "termLink")
       tok <- termLink'
       pure $ Term.termLink (ann tok) (L.payload tok)
 
@@ -200,7 +200,7 @@ matchCase = do
       unit ann = Pattern.Constructor ann (ConstructorReference DD.unitRef 0) []
       pair p1 p2 = Pattern.Constructor (ann p1 <> ann p2) (ConstructorReference DD.pairRef 0) [p1, p2]
   let guardedBlocks = label "pattern guard" . some $ do
-        reserved "|"
+        _ <- reserved "|"
         guard <-
           asum
             [ Nothing <$ P.try (quasikeyword "otherwise"),
@@ -289,7 +289,7 @@ parsePattern = label "pattern" root
           | Set.null s -> die tok s
           | Set.size s > 1 -> die tok s
           | otherwise -> -- matched ctor name, consume the token
-              do anyToken; pure (Set.findMin s <$ tok)
+              do _ <- anyToken; pure (Set.findMin s <$ tok)
       where
         isLower = Text.all Char.isLower . Text.take 1 . Name.toText
         die hq s = case L.payload hq of
@@ -1054,7 +1054,7 @@ destructuringBind = do
   (p, boundVars) <- P.try do
     (p, boundVars) <- parsePattern
     let boundVars' = snd <$> boundVars
-    P.lookAhead (openBlockWith "=")
+    _ <- P.lookAhead (openBlockWith "=")
     pure (p, boundVars')
   (_spanAnn, scrute) <- block "=" -- Dwight K. Scrute ("The People's Scrutinee")
   let guard = Nothing

parser-typechecker/src/Unison/Typechecker/Context.hs

@@ -2197,7 +2197,7 @@ coalesceWanted' keep ((loc, n) : new) old
         if keep u
           then pure (new, (loc, n) : old)
           else do
-            defaultAbility n
+            _ <- defaultAbility n
             pure (new, old)
       coalesceWanted new old
   | otherwise = coalesceWanted' keep new ((loc, n) : old)

parser-typechecker/src/Unison/Util/PinBoard.hs

@@ -1,143 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
--- | A utility type for saving memory in the presence of many duplicate ByteStrings, etc. If you have data that may be
--- a redundant duplicate, try pinning it to a pin board, and use the result of that operation instead.
---
---   Without a pin board:
---
---     x ───── "38dce848c8c829c62"
---     y ───── "38dce848c8c829c62"
---     z ───── "d2518f260535b927b"
---
---   With a pin board:
---
---     x ───── "38dce848c8c829c62" ┄┄┄┄┄┐
---     y ────────┘                     board
---     z ───── "d2518f260535b927b" ┄┄┄┄┄┘
---
---   ... and after x is garbage collected:
---
---             "38dce848c8c829c62" ┄┄┄┄┄┐
---     y ────────┘                     board
---     z ───── "d2518f260535b927b" ┄┄┄┄┄┘
---
---   ... and after y is garbage collected:
---
---                                     board
---     z ───── "d2518f260535b927b" ┄┄┄┄┄┘
-module Unison.Util.PinBoard
-  ( PinBoard,
-    new,
-    pin,
-
-    -- * For debugging
-    debugDump,
-    debugSize,
-  )
-where
-
-import Control.Concurrent.MVar
-import Data.Foldable (find, foldlM)
-import Data.Functor.Compose
-import Data.Hashable (Hashable, hash)
-import Data.IntMap qualified as IntMap
-import Data.IntMap.Strict (IntMap)
-import Data.Text qualified as Text
-import Data.Text.IO qualified as Text
-import Data.Tuple (swap)
-import System.Mem.Weak (Weak, deRefWeak, mkWeakPtr)
-import Unison.Prelude
-
--- | A "pin board" is a place to pin values; semantically, it's a set, but differs in a few ways:
---
---   * Pinned values aren't kept alive by the pin board, they might be garbage collected at any time.
---   * If you try to pin a value that's already pinned (per its Eq instance), the pinned one will be returned
---     instead.
---   * It has a small API: just 'new' and 'pin'.
-newtype PinBoard a
-  = PinBoard (MVar (IntMap (Bucket a)))
-
-new :: (MonadIO m) => m (PinBoard a)
-new =
-  liftIO (PinBoard <$> newMVar IntMap.empty)
-
-pin :: forall a m. (Eq a, Hashable a, MonadIO m) => PinBoard a -> a -> m a
-pin (PinBoard boardVar) x = liftIO do
-  modifyMVar boardVar \board ->
-    swap <$> getCompose (IntMap.alterF alter n board)
-  where
-    -- Pin to pin board at a hash key: either there's nothing there (ifMiss), or there's a nonempty bucket (ifHit).
-    alter :: Maybe (Bucket a) -> Compose IO ((,) a) (Maybe (Bucket a))
-    alter =
-      Compose . maybe ifMiss ifHit
-    -- Pin a new value: create a new singleton bucket.
-    ifMiss :: IO (a, Maybe (Bucket a))
-    ifMiss =
-      (x,) . Just <$> newBucket x finalizer
-    -- Possibly pin a new value: if it already exists in the bucket, return that one instead. Otherwise, insert it.
-    ifHit :: Bucket a -> IO (a, Maybe (Bucket a))
-    ifHit bucket =
-      bucketFind bucket x >>= \case
-        -- Hash collision: the bucket has things in it, but none are the given value. Insert.
-        Nothing -> (x,) . Just <$> bucketAdd bucket x finalizer
-        -- The thing being inserted already exists; return it.
-        Just y -> pure (y, Just bucket)
-    -- When each thing pinned here is garbage collected, compact its bucket.
-    finalizer :: IO ()
-    finalizer =
-      modifyMVar_ boardVar (IntMap.alterF (maybe (pure Nothing) bucketCompact) n)
-    n :: Int
-    n =
-      hash x
-
-debugDump :: (MonadIO m) => (a -> Text) -> PinBoard a -> m ()
-debugDump f (PinBoard boardVar) = liftIO do
-  board <- readMVar boardVar
-  contents <- (traverse . traverse) bucketToList (IntMap.toList board)
-  Text.putStrLn (Text.unlines ("PinBoard" : map row contents))
-  where
-    row (n, xs) =
-      Text.pack (show n) <> " => " <> Text.pack (show (map f xs))
-
-debugSize :: PinBoard a -> IO Int
-debugSize (PinBoard boardVar) = do
-  board <- readMVar boardVar
-  foldlM step 0 board
-  where
-    step :: Int -> Bucket a -> IO Int
-    step acc =
-      bucketToList >=> \xs -> pure (acc + length xs)
-
--- | A bucket of weak pointers to different values that all share a hash.
-newtype Bucket a
-  = Bucket [Weak a] -- Invariant: non-empty list
-
--- | A singleton bucket.
-newBucket :: a -> IO () -> IO (Bucket a)
-newBucket =
-  bucketAdd (Bucket [])
-
--- | Add a value to a bucket.
-bucketAdd :: Bucket a -> a -> IO () -> IO (Bucket a)
-bucketAdd (Bucket weaks) x finalizer = do
-  weak <- mkWeakPtr x (Just finalizer)
-  pure (Bucket (weak : weaks))
-
--- | Drop all garbage-collected values from a bucket. If none remain, returns Nothing.
-bucketCompact :: Bucket a -> IO (Maybe (Bucket a))
-bucketCompact (Bucket weaks) =
-  bucketFromList <$> mapMaybeM (\w -> (w <$) <$> deRefWeak w) weaks
-
--- | Look up a value in a bucket per its Eq instance.
-bucketFind :: (Eq a) => Bucket a -> a -> IO (Maybe a)
-bucketFind bucket x =
-  find (== x) <$> bucketToList bucket
-
-bucketFromList :: [Weak a] -> Maybe (Bucket a)
-bucketFromList = \case
-  [] -> Nothing
-  weaks -> Just (Bucket weaks)
-
-bucketToList :: Bucket a -> IO [a]
-bucketToList (Bucket weaks) =
-  mapMaybeM deRefWeak weaks

parser-typechecker/tests/Suite.hs

@@ -26,7 +26,6 @@ import Unison.Test.Typechecker qualified as Typechecker
 import Unison.Test.Typechecker.Context qualified as Context
 import Unison.Test.Typechecker.TypeError qualified as TypeError
 import Unison.Test.UnisonSources qualified as UnisonSources
-import Unison.Test.Util.PinBoard qualified as PinBoard
 import Unison.Test.Util.Relation qualified as Relation
 import Unison.Test.Util.Text qualified as Text
 import Unison.Test.Var qualified as Var
@@ -54,7 +53,6 @@ test =
       Typechecker.test,
       Context.test,
       Name.test,
-      PinBoard.test,
       CodebaseInit.test,
       Branch.test
     ]

parser-typechecker/tests/Unison/Test/MCode.hs

@@ -44,7 +44,7 @@ testEval0 :: [(Reference, SuperGroup Symbol)] -> SuperGroup Symbol -> Test ()
 testEval0 env main =
   ok << io do
     cc <- baseCCache False
-    cacheAdd ((mainRef, main) : env) cc
+    _ <- cacheAdd ((mainRef, main) : env) cc
     rtm <- readTVarIO (refTm cc)
     apply0 Nothing cc Nothing (rtm Map.! mainRef)
   where

parser-typechecker/tests/Unison/Test/Util/PinBoard.hs

@@ -1,52 +0,0 @@
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-
-module Unison.Test.Util.PinBoard
-  ( test,
-  )
-where
-
-import Data.ByteString qualified as ByteString
-import EasyTest
-import GHC.Exts (isTrue#, reallyUnsafePtrEquality#, touch#)
-import GHC.IO (IO (IO))
-import System.Mem (performGC)
-import Unison.Util.PinBoard qualified as PinBoard
-
-test :: Test ()
-test =
-  scope "util.pinboard" . tests $
-    [ scope "pinning equal values stores only one" $ do
-        let b0 = ByteString.singleton 0
-        let b1 = ByteString.copy b0
-
-        board <- PinBoard.new
-
-        -- pinning a thing for the first time returns it
-        b0' <- PinBoard.pin board b0
-        expectSamePointer b0 b0'
-
-        -- pinning an equal thing returns the first
-        b1' <- PinBoard.pin board b1
-        expectSamePointer b0 b1'
-
-        -- the board should only have one value in it
-        expect' . (== 1) <$> io (PinBoard.debugSize board)
-
-        -- keep b0 alive until here
-        touch b0
-
-        -- observe that the board doesn't keep its value alive
-        io performGC
-        expect' . (== 0) <$> io (PinBoard.debugSize board)
-
-        ok
-    ]
-
-expectSamePointer :: a -> a -> Test ()
-expectSamePointer x y =
-  expect' (isTrue# (reallyUnsafePtrEquality# x y))
-
-touch :: a -> Test ()
-touch x =
-  io (IO \s -> (# touch# x s, () #))

parser-typechecker/unison-parser-typechecker.cabal

@@ -185,7 +185,6 @@ library
       Unison.Util.EnumContainers
       Unison.Util.Exception
       Unison.Util.Logger
-      Unison.Util.PinBoard
       Unison.Util.Pretty.MegaParsec
       Unison.Util.RefPromise
       Unison.Util.Star2
@@ -385,7 +384,6 @@ test-suite parser-typechecker-tests
       Unison.Test.Typechecker.Context
       Unison.Test.Typechecker.TypeError
       Unison.Test.UnisonSources
-      Unison.Test.Util.PinBoard
       Unison.Test.Util.Pretty
       Unison.Test.Util.Relation
       Unison.Test.Util.Text

unison-cli/src/Unison/Cli/MergeTypes.hs

@@ -0,0 +1,32 @@
+-- | Common types related to merge, pulled down far enough to be imported by all interested parties.
+module Unison.Cli.MergeTypes
+  ( MergeSource (..),
+    MergeTarget,
+    MergeSourceAndTarget (..),
+    MergeSourceOrTarget (..),
+  )
+where
+
+import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace, ReadShareLooseCode)
+import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName)
+
+-- | What are we merging in?
+data MergeSource
+  = MergeSource'LocalProjectBranch !(ProjectAndBranch ProjectName ProjectBranchName)
+  | MergeSource'RemoteProjectBranch !(ProjectAndBranch ProjectName ProjectBranchName)
+  | MergeSource'RemoteLooseCode !ReadShareLooseCode
+  | MergeSource'RemoteGitRepo !ReadGitRemoteNamespace
+
+type MergeTarget =
+  ProjectAndBranch ProjectName ProjectBranchName
+
+-- | "Alice and Bob"
+data MergeSourceAndTarget = MergeSourceAndTarget
+  { alice :: !MergeTarget,
+    bob :: !MergeSource
+  }
+
+-- | "Either Alice Bob"
+data MergeSourceOrTarget
+  = MergeSourceOrTarget'Source !MergeSource
+  | MergeSourceOrTarget'Target !MergeTarget

unison-cli/src/Unison/Cli/Pretty.hs

@@ -19,6 +19,8 @@ module Unison.Cli.Pretty
     prettyLabeledDependencies,
     prettyPath,
     prettyPath',
+    prettyMergeSource,
+    prettyMergeSourceOrTarget,
     prettyProjectAndBranchName,
     prettyBranchName,
     prettyProjectBranchName,
@@ -69,6 +71,7 @@ import U.Codebase.Sqlite.Project qualified as Sqlite
 import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
 import U.Util.Base32Hex (Base32Hex)
 import U.Util.Base32Hex qualified as Base32Hex
+import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..))
 import Unison.Cli.ProjectUtils (projectBranchPathPrism)
 import Unison.Cli.Share.Projects.Types qualified as Share
 import Unison.Codebase.Editor.DisplayObject (DisplayObject (BuiltinObject, MissingObject, UserObject))
@@ -76,7 +79,7 @@ import Unison.Codebase.Editor.Input qualified as Input
 import Unison.Codebase.Editor.Output
 import Unison.Codebase.Editor.RemoteRepo
   ( ReadGitRepo,
-    ReadRemoteNamespace,
+    ReadRemoteNamespace (..),
     ShareUserHandle (..),
     WriteGitRepo,
     WriteRemoteNamespace (..),
@@ -225,6 +228,18 @@ prettyHash = prettyBase32Hex# . Hash.toBase32Hex
 prettyHash32 :: (IsString s) => Hash32 -> P.Pretty s
 prettyHash32 = prettyBase32Hex# . Hash32.toBase32Hex
 
+prettyMergeSource :: MergeSource -> Pretty
+prettyMergeSource = \case
+  MergeSource'LocalProjectBranch branch -> prettyProjectAndBranchName branch
+  MergeSource'RemoteProjectBranch branch -> "remote " <> prettyProjectAndBranchName branch
+  MergeSource'RemoteLooseCode info -> prettyReadRemoteNamespace (ReadShare'LooseCode info)
+  MergeSource'RemoteGitRepo info -> prettyReadRemoteNamespace (ReadRemoteNamespaceGit info)
+
+prettyMergeSourceOrTarget :: MergeSourceOrTarget -> Pretty
+prettyMergeSourceOrTarget = \case
+  MergeSourceOrTarget'Target alice -> prettyProjectAndBranchName alice
+  MergeSourceOrTarget'Source bob -> prettyMergeSource bob
+
 prettyProjectName :: ProjectName -> Pretty
 prettyProjectName =
   P.green . P.text . into @Text

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

@@ -435,8 +435,11 @@ loop e = do
               let destp = looseCodeOrProjectToPath dest0
               srcb <- Cli.expectBranchAtPath' srcp
               dest <- Cli.resolvePath' destp
-              -- todo: fixme: use project and branch names
-              let err = Just $ MergeAlreadyUpToDate src0 dest0
+              let err =
+                    Just $
+                      MergeAlreadyUpToDate
+                        ((\x -> ProjectAndBranch x.project.name x.branch.name) <$> src0)
+                        ((\x -> ProjectAndBranch x.project.name x.branch.name) <$> dest0)
               mergeBranchAndPropagateDefaultPatch mergeMode description err srcb (Just dest0) dest
             PreviewMergeLocalBranchI src0 dest0 -> do
               Cli.Env {codebase} <- ask
@@ -1025,7 +1028,7 @@ loop e = do
               pped <- Cli.currentPrettyPrintEnvDecl
               let suffixifiedPPE = PPED.suffixifiedPPE pped
               Cli.respondNumbered $ ListEdits patch suffixifiedPPE
-            PullRemoteBranchI sourceTarget pMode verbosity -> handlePull sourceTarget pMode verbosity
+            PullI sourceTarget pullMode -> handlePull sourceTarget pullMode
             PushRemoteBranchI pushRemoteBranchInput -> handlePushRemoteBranch pushRemoteBranchInput
             ListDependentsI hq -> handleDependents hq
             ListDependenciesI hq -> handleDependencies hq
@@ -1169,7 +1172,6 @@ loop e = do
             DeprecateTypeI {} -> Cli.respond NotImplemented
             RemoveTermReplacementI from patchPath -> doRemoveReplacement from patchPath True
             RemoveTypeReplacementI from patchPath -> doRemoveReplacement from patchPath False
-            ShowDefinitionByPrefixI {} -> Cli.respond NotImplemented
             UpdateBuiltinsI -> Cli.respond NotImplemented
             QuitI -> Cli.haltRepl
             GistI input -> handleGist input
@@ -1391,11 +1393,10 @@ inputDescription input =
     ProjectRenameI {} -> wat
     ProjectSwitchI {} -> wat
     ProjectsI -> wat
-    PullRemoteBranchI {} -> wat
+    PullI {} -> wat
     PushRemoteBranchI {} -> wat
     QuitI {} -> wat
     ReleaseDraftI {} -> wat
-    ShowDefinitionByPrefixI {} -> wat
     ShowDefinitionI {} -> wat
     EditNamespaceI paths ->
       pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths))

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

@@ -1,5 +1,12 @@
 module Unison.Codebase.Editor.HandleInput.Merge2
   ( handleMerge,
+
+    -- * API exported for @pull@
+    MergeInfo (..),
+    AliceMergeInfo (..),
+    BobMergeInfo (..),
+    LcaMergeInfo (..),
+    doMerge,
   )
 where
 
@@ -12,9 +19,12 @@ import Data.Bitraversable (bitraverse)
 import Data.Foldable qualified as Foldable
 import Data.List qualified as List
 import Data.List.NonEmpty (pattern (:|))
+import Data.List.NonEmpty qualified as List.NonEmpty
 import Data.Map.Strict qualified as Map
 import Data.Semialign (align, unzip)
 import Data.Set qualified as Set
+import Data.Set.NonEmpty (NESet)
+import Data.Set.NonEmpty qualified as Set.NonEmpty
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Data.These (These (..))
@@ -24,13 +34,16 @@ import Text.Builder qualified as Text (Builder)
 import U.Codebase.Branch qualified as V2 (Branch (..), CausalBranch)
 import U.Codebase.Branch qualified as V2.Branch
 import U.Codebase.Causal qualified as V2.Causal
-import U.Codebase.HashTags (unCausalHash)
+import U.Codebase.HashTags (CausalHash, unCausalHash)
 import U.Codebase.Reference (Reference, TermReferenceId, TypeReference, TypeReferenceId)
 import U.Codebase.Referent qualified as V2 (Referent)
+import U.Codebase.Sqlite.DbId (ProjectId)
 import U.Codebase.Sqlite.Operations qualified as Operations
 import U.Codebase.Sqlite.Project (Project (..))
 import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
+import U.Codebase.Sqlite.Queries qualified as Queries
 import Unison.Builtin.Decls qualified as Builtin.Decls
+import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..), MergeSourceAndTarget (..))
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli
@@ -47,8 +60,9 @@ import Unison.Codebase.Editor.HandleInput.Update2
     prettyParseTypecheck2,
     typecheckedUnisonFileToBranchAdds,
   )
-import Unison.Codebase.Editor.Output (Output)
 import Unison.Codebase.Editor.Output qualified as Output
+import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace (..), ReadShareLooseCode (..))
+import Unison.Codebase.Path (Path)
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache)
 import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions
@@ -71,7 +85,6 @@ import Unison.Merge.EitherWayI (EitherWayI (..))
 import Unison.Merge.EitherWayI qualified as EitherWayI
 import Unison.Merge.Libdeps qualified as Merge
 import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs)
-import Unison.Merge.PreconditionViolation qualified as Merge
 import Unison.Merge.Synhashed (Synhashed (..))
 import Unison.Merge.Synhashed qualified as Synhashed
 import Unison.Merge.ThreeWay (ThreeWay (..))
@@ -111,12 +124,12 @@ import Unison.Typechecker qualified as Typechecker
 import Unison.Util.BiMultimap (BiMultimap)
 import Unison.Util.BiMultimap qualified as BiMultimap
 import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith, defnsAreEmpty, zipDefnsWith, zipDefnsWith3)
+import Unison.Util.Monoid qualified as Monoid
 import Unison.Util.Nametree (Nametree (..), flattenNametree, traverseNametreeWithName, unflattenNametree)
 import Unison.Util.Pretty (ColorText, Pretty)
 import Unison.Util.Pretty qualified as Pretty
 import Unison.Util.Relation (Relation)
 import Unison.Util.Relation qualified as Relation
-import Unison.Util.Set qualified as Set
 import Unison.Util.Star2 (Star2)
 import Unison.Util.Star2 qualified as Star2
 import Unison.Util.SyntaxText (SyntaxText')
@@ -125,45 +138,114 @@ import Witch (unsafeFrom)
 import Prelude hiding (unzip, zip, zipWith)
 
 handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
-handleMerge bobSpecifier = do
+handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do
+  -- Assert that Alice (us) is on a project branch, and grab the causal hash.
+  (ProjectAndBranch aliceProject aliceProjectBranch, _path) <- Cli.expectCurrentProjectBranch
+  aliceCausalHash <- Cli.runTransaction (projectBranchToCausalHash aliceProjectBranch)
+
+  -- Resolve Bob's maybe-project-name + branch-name to the info the merge algorithm needs: the project name, branch
+  -- name, and causal hash.
+  bobProject <-
+    case maybeBobProjectName of
+      Nothing -> pure aliceProject
+      Just bobProjectName
+        | bobProjectName == aliceProject.name -> pure aliceProject
+        | otherwise -> do
+            Cli.runTransaction (Queries.loadProjectByName bobProjectName)
+              & onNothingM (Cli.returnEarly (Output.LocalProjectDoesntExist bobProjectName))
+  bobProjectBranch <- Cli.expectProjectBranchByName bobProject bobBranchName
+  bobCausalHash <- Cli.runTransaction (projectBranchToCausalHash bobProjectBranch)
+
+  -- Using Alice and Bob's causal hashes, find the LCA (if it exists)
+  lcaCausalHash <- Cli.runTransaction (Operations.lca aliceCausalHash bobCausalHash)
+
+  -- Do the merge!
+  doMerge
+    MergeInfo
+      { alice =
+          AliceMergeInfo
+            { causalHash = aliceCausalHash,
+              project = aliceProject,
+              projectBranch = aliceProjectBranch
+            },
+        bob =
+          BobMergeInfo
+            { causalHash = bobCausalHash,
+              source = MergeSource'LocalProjectBranch (ProjectAndBranch bobProject.name bobBranchName)
+            },
+        lca =
+          LcaMergeInfo
+            { causalHash = lcaCausalHash
+            },
+        description = "merge " <> into @Text (ProjectAndBranch bobProject.name bobBranchName)
+      }
+  where
+    projectBranchToCausalHash :: ProjectBranch -> Transaction CausalHash
+    projectBranchToCausalHash branch = do
+      let path = Cli.projectBranchPath (ProjectAndBranch branch.projectId branch.branchId)
+      causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path)
+      pure causal.causalHash
+
+data MergeInfo = MergeInfo
+  { alice :: !AliceMergeInfo,
+    bob :: BobMergeInfo,
+    lca :: !LcaMergeInfo,
+    -- | How should we describe this merge in the reflog?
+    description :: !Text
+  }
+
+data AliceMergeInfo = AliceMergeInfo
+  { causalHash :: !CausalHash,
+    project :: !Project,
+    projectBranch :: !ProjectBranch
+  }
+
+data BobMergeInfo = BobMergeInfo
+  { causalHash :: !CausalHash,
+    source :: !MergeSource
+  }
+
+newtype LcaMergeInfo = LcaMergeInfo
+  { causalHash :: Maybe CausalHash
+  }
+
+doMerge :: MergeInfo -> Cli ()
+doMerge info = do
   let debugFunctions =
         if Debug.shouldDebug Debug.Merge
           then realDebugFunctions
           else fakeDebugFunctions
 
+  let alicePath = Cli.projectBranchPath (ProjectAndBranch info.alice.project.projectId info.alice.projectBranch.branchId)
+  let aliceBranchNames = ProjectAndBranch info.alice.project.name info.alice.projectBranch.name
+  let mergeSource = MergeSourceOrTarget'Source info.bob.source
+  let mergeTarget = MergeSourceOrTarget'Target aliceBranchNames
+  let mergeSourceAndTarget = MergeSourceAndTarget { alice = aliceBranchNames, bob = info.bob.source }
+
   Cli.Env {codebase} <- ask
 
+  -- If alice == bob, or LCA == bob (so alice is ahead of bob), then we are done.
+  when (info.alice.causalHash == info.bob.causalHash || info.lca.causalHash == Just info.bob.causalHash) do
+    Cli.returnEarly (Output.MergeAlreadyUpToDate2 mergeSourceAndTarget)
+
+  -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done.
+  when (info.lca.causalHash == Just info.alice.causalHash) do
+    bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash)
+    _ <- Cli.updateAt info.description alicePath (\_aliceBranch -> bobBranch)
+    Cli.returnEarly (Output.MergeSuccessFastForward mergeSourceAndTarget)
+
   -- Create a bunch of cached database lookup functions
   db <- makeMergeDatabase codebase
 
-  -- Load the current project branch ("Alice"), and the branch from the same project to merge in ("Bob")
-  info <- loadMergeInfo bobSpecifier
-  let projectAndBranchNames = (\x -> ProjectAndBranch x.project.name x.branch.name) <$> info.branches
-
   -- Load Alice/Bob/LCA causals
-  causals <-
-    Cli.runTransaction do
-      alice <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute info.paths.alice)
-      bob <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute info.paths.bob)
-      lca <-
-        Operations.lca alice.causalHash bob.causalHash >>= \case
-          Nothing -> pure Nothing
-          Just lcaCausalHash -> Just <$> db.loadCausal lcaCausalHash
-      pure TwoOrThreeWay {lca, alice, bob}
-
-  -- If alice == bob, then we are done.
-  when (causals.alice == causals.bob) do
-    Cli.returnEarly (Output.MergeAlreadyUpToDate (Right info.branches.bob) (Right info.branches.alice))
-
-  -- Otherwise, if LCA == bob, then we are ahead of bob, so we are done.
-  when (causals.lca == Just causals.bob) do
-    Cli.returnEarly (Output.MergeAlreadyUpToDate (Right info.branches.bob) (Right info.branches.alice))
-
-  -- Otherwise, if LCA == alice, then we can fast forward to bob, and we're done.
-  when (causals.lca == Just causals.alice) do
-    bobBranch <- Cli.getBranchAt info.paths.bob
-    _ <- Cli.updateAt (textualDescriptionOfMerge info) info.paths.alice (\_aliceBranch -> bobBranch)
-    Cli.returnEarly (Output.MergeSuccessFastForward projectAndBranchNames.alice projectAndBranchNames.bob)
+  causals <- Cli.runTransaction do
+    traverse
+      Operations.expectCausalBranchByCausalHash
+      TwoOrThreeWay
+        { alice = info.alice.causalHash,
+          bob = info.bob.causalHash,
+          lca = info.lca.causalHash
+        }
 
   liftIO (debugFunctions.debugCausals causals)
 
@@ -175,25 +257,64 @@ handleMerge bobSpecifier = do
       lca <- for causals.lca \causal -> causal.value
       pure TwoOrThreeWay {lca, alice, bob}
 
+  -- Assert that neither Alice nor Bob have defns in lib
+  for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do
+    libdeps <-
+      case Map.lookup NameSegment.libSegment branch.children of
+        Nothing -> pure V2.Branch.empty
+        Just libdeps -> Cli.runTransaction libdeps.value
+    when (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) do
+      Cli.returnEarly (Output.MergeDefnsInLib who)
+
   -- Load Alice/Bob/LCA definitions and decl name lookups
-  (defns3, declNameLookups3) <-
-    Cli.runTransactionWithRollback \abort -> do
-      loadDefns abort db (view #branch <$> info.branches) branches
+  (defns3, declNameLookups3) <- do
+    let load = \case
+          Nothing ->
+            pure
+              ( Nametree {value = Defns Map.empty Map.empty, children = Map.empty},
+                DeclNameLookup Map.empty Map.empty
+              )
+          Just (who, branch) -> do
+            defns <-
+              Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName ->
+                Cli.returnEarly case conflictedName of
+                  ConflictedName'Term name refs -> Output.MergeConflictedTermName name refs
+                  ConflictedName'Type name refs -> Output.MergeConflictedTypeName name refs
+            declNameLookup <-
+              Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err ->
+                Cli.returnEarly case err of
+                  IncoherentDeclReason'ConstructorAlias name1 name2 ->
+                    Output.MergeConstructorAlias who name1 name2
+                  IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name
+                  IncoherentDeclReason'NestedDeclAlias shorterName longerName ->
+                    Output.MergeNestedDeclAlias who shorterName longerName
+                  IncoherentDeclReason'StrayConstructor name -> Output.MergeStrayConstructor who name
+            pure (defns, declNameLookup)
+
+    (aliceDefns0, aliceDeclNameLookup) <- load (Just (Just mergeTarget, branches.alice))
+    (bobDefns0, bobDeclNameLookup) <- load (Just (Just mergeSource, branches.bob))
+    (lcaDefns0, lcaDeclNameLookup) <- load ((Nothing,) <$> branches.lca)
+
+    let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns)
+    let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0}
+    let declNameLookups3 = ThreeWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup, lca = lcaDeclNameLookup}
+
+    pure (defns3, declNameLookups3)
+
   let defns = ThreeWay.forgetLca defns3
   let declNameLookups = ThreeWay.forgetLca declNameLookups3
 
   liftIO (debugFunctions.debugDefns defns3 declNameLookups3)
 
   -- Diff LCA->Alice and LCA->Bob
-  diffs <-
-    Cli.runTransaction do
-      Merge.nameBasedNamespaceDiff db declNameLookups3 defns3
+  diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups3 defns3)
 
   liftIO (debugFunctions.debugDiffs diffs)
 
   -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias
-  whenJust (findOneConflictedAlias (view #branch <$> info.branches) defns3.lca diffs) \violation ->
-    Cli.returnEarly (mergePreconditionViolationToOutput violation)
+  for_ ((,) <$> TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) ->
+    whenJust (findConflictedAlias defns3.lca diff) \(name1, name2) ->
+      Cli.returnEarly (Output.MergeConflictedAliases who name1 name2)
 
   -- Combine the LCA->Alice and LCA->Bob diffs together
   let diff = combineDiffs diffs
@@ -203,7 +324,7 @@ handleMerge bobSpecifier = do
   -- Partition the combined diff into the conflicted things and the unconflicted things
   (conflicts, unconflicts) <-
     partitionCombinedDiffs defns declNameLookups diff & onLeft \name ->
-      Cli.returnEarly (mergePreconditionViolationToOutput (Merge.ConflictInvolvingBuiltin name))
+      Cli.returnEarly (Output.MergeConflictInvolvingBuiltin name)
 
   liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts)
 
@@ -272,7 +393,27 @@ handleMerge bobSpecifier = do
                 <*> hydratedThings
                 <*> ppes
 
-  let prettyUnisonFile = makePrettyUnisonFile (into @Text <$> projectAndBranchNames) renderedConflicts renderedDependents
+  let prettyUnisonFile =
+        makePrettyUnisonFile
+          TwoWay
+            { alice = into @Text aliceBranchNames,
+              bob =
+                case info.bob.source of
+                  MergeSource'LocalProjectBranch bobBranchNames -> into @Text bobBranchNames
+                  MergeSource'RemoteProjectBranch bobBranchNames
+                    | aliceBranchNames == bobBranchNames -> "remote " <> into @Text bobBranchNames
+                    | otherwise -> into @Text bobBranchNames
+                  MergeSource'RemoteLooseCode info ->
+                    case Path.toName info.path of
+                      Nothing -> "<root>"
+                      Just name -> Name.toText name
+                  MergeSource'RemoteGitRepo info ->
+                    case Path.toName info.path of
+                      Nothing -> "<root>"
+                      Just name -> Name.toText name
+            }
+          renderedConflicts
+          renderedDependents
 
   let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps
 
@@ -287,84 +428,38 @@ handleMerge bobSpecifier = do
             parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch)
             prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe
 
+  let parents =
+        (\causal -> (causal.causalHash, Codebase.expectBranchForHash codebase causal.causalHash)) <$> causals
+
   case maybeTypecheckedUnisonFile of
     Nothing -> do
       Cli.Env {writeSource} <- ask
-      aliceBranch <- Cli.getBranchAt info.paths.alice
-      bobBranch <- Cli.getBranchAt info.paths.bob
       _temporaryBranchId <-
         HandleInput.Branch.doCreateBranch'
-          (Branch.mergeNode stageOneBranch aliceBranch bobBranch)
+          (Branch.mergeNode stageOneBranch parents.alice parents.bob)
           Nothing
-          info.branches.alice.project
-          (findTemporaryBranchName info)
-          (textualDescriptionOfMerge info)
+          info.alice.project
+          (findTemporaryBranchName info.alice.project.projectId mergeSourceAndTarget)
+          info.description
       scratchFilePath <-
         Cli.getLatestFile <&> \case
           Nothing -> "scratch.u"
           Just (file, _) -> file
       liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile)
-      Cli.respond $
-        Output.MergeFailure
-          scratchFilePath
-          projectAndBranchNames.alice
-          projectAndBranchNames.bob
+      Cli.respond (Output.MergeFailure scratchFilePath mergeSourceAndTarget)
     Just tuf -> do
       Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf)
-      bobBranch <- Cli.getBranchAt info.paths.bob
       let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch
       _ <-
         Cli.updateAt
-          (textualDescriptionOfMerge info)
-          info.paths.alice
-          (\aliceBranch -> Branch.mergeNode stageTwoBranch aliceBranch bobBranch)
-      Cli.respond (Output.MergeSuccess projectAndBranchNames.alice projectAndBranchNames.bob)
+          info.description
+          alicePath
+          (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob)
+      Cli.respond (Output.MergeSuccess mergeSourceAndTarget)
 
 ------------------------------------------------------------------------------------------------------------------------
 -- Loading basic info out of the database
 
-loadMergeInfo :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli MergeInfo
-loadMergeInfo (ProjectAndBranch maybeBobProjectName bobBranchName) = do
-  (aliceProjectBranch, _path) <- Cli.expectCurrentProjectBranch
-  bobProjectBranch <-
-    Cli.expectProjectAndBranchByTheseNames case maybeBobProjectName of
-      Nothing -> That bobBranchName
-      Just bobProjectName -> These bobProjectName bobBranchName
-  let alicePath = Cli.projectBranchPath (ProjectAndBranch aliceProjectBranch.project.projectId aliceProjectBranch.branch.branchId)
-  let bobPath = Cli.projectBranchPath (ProjectAndBranch bobProjectBranch.project.projectId bobProjectBranch.branch.branchId)
-  pure
-    MergeInfo
-      { paths = TwoWay alicePath bobPath,
-        branches = TwoWay aliceProjectBranch bobProjectBranch
-      }
-
-loadDefns ::
-  (forall a. Output -> Transaction a) ->
-  MergeDatabase ->
-  TwoWay ProjectBranch ->
-  TwoOrThreeWay (V2.Branch Transaction) ->
-  Transaction
-    ( ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)),
-      ThreeWay DeclNameLookup
-    )
-loadDefns abort0 db projectBranches branches = do
-  lcaDefns0 <-
-    case branches.lca of
-      Nothing -> pure Nametree {value = Defns Map.empty Map.empty, children = Map.empty}
-      Just lcaBranch -> loadNamespaceInfo abort db lcaBranch
-  aliceDefns0 <- loadNamespaceInfo abort db branches.alice
-  bobDefns0 <- loadNamespaceInfo abort db branches.bob
-
-  lca <- assertNamespaceSatisfiesPreconditions db abort Nothing (fromMaybe V2.Branch.empty branches.lca) lcaDefns0
-  alice <- assertNamespaceSatisfiesPreconditions db abort (Just projectBranches.alice.name) branches.alice aliceDefns0
-  bob <- assertNamespaceSatisfiesPreconditions db abort (Just projectBranches.bob.name) branches.bob bobDefns0
-
-  pure (unzip ThreeWay {lca, alice, bob})
-  where
-    abort :: Merge.PreconditionViolation -> Transaction void
-    abort =
-      abort0 . mergePreconditionViolationToOutput
-
 loadLibdeps ::
   TwoOrThreeWay (V2.Branch Transaction) ->
   Transaction (ThreeWay (Map NameSegment (V2.CausalBranch Transaction)))
@@ -501,13 +596,16 @@ makePrettyUnisonFile authors conflicts dependents =
                     bob = prettyBinding (Just (Pretty.text authors.bob))
              in bifoldMap f f
           ),
-      if TwoWay.or (not . defnsAreEmpty <$> dependents)
-        then
-          fold
-            [ "-- The definitions below are not conflicted, but they each depend on one or more\n",
-              "-- conflicted definitions above.\n\n"
-            ]
-        else mempty,
+      -- Show message that delineates where conflicts end and dependents begin only when there are both conflicts and
+      -- dependents
+      let thereAre defns = TwoWay.or (not . defnsAreEmpty <$> defns)
+       in if thereAre conflicts && thereAre dependents
+            then
+              fold
+                [ "-- The definitions below are not conflicted, but they each depend on one or more\n",
+                  "-- conflicted definitions above.\n\n"
+                ]
+            else mempty,
       dependents
         -- Merge dependents together into one map (they are disjoint)
         & TwoWay.twoWay (zipDefnsWith Map.union Map.union)
@@ -621,17 +719,6 @@ nametreeToBranch0 nametree =
     rel2star rel =
       Star2.Star2 {fact = Relation.dom rel, d1 = rel, d2 = Relation.empty}
 
-data MergeInfo = MergeInfo
-  { paths :: !(TwoWay Path.Absolute),
-    branches :: !(TwoWay (ProjectAndBranch Project ProjectBranch))
-  }
-  deriving stock (Generic)
-
-textualDescriptionOfMerge :: MergeInfo -> Text
-textualDescriptionOfMerge info =
-  let bobBranchText = into @Text (ProjectAndBranch info.branches.bob.project.name info.branches.bob.branch.name)
-   in "merge " <> bobBranchText
-
 -- FIXME: let's come up with a better term for "dependencies" in the implementation of this function
 identifyDependents ::
   TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
@@ -749,30 +836,40 @@ defnsToNames defns =
       types = Relation.fromMap (BiMultimap.range defns.types)
     }
 
-findTemporaryBranchName :: MergeInfo -> Transaction ProjectBranchName
-findTemporaryBranchName info = do
-  Cli.findTemporaryBranchName info.branches.alice.project.projectId preferred
+findTemporaryBranchName :: ProjectId -> MergeSourceAndTarget -> Transaction ProjectBranchName
+findTemporaryBranchName projectId mergeSourceAndTarget = do
+  Cli.findTemporaryBranchName projectId preferred
   where
     preferred :: ProjectBranchName
     preferred =
       unsafeFrom @Text $
-        "merge-"
-          <> mangle info.branches.bob.branch.name
-          <> "-into-"
-          <> mangle info.branches.alice.branch.name
+        Text.Builder.run $
+          "merge-"
+            <> mangleMergeSource mergeSourceAndTarget.bob
+            <> "-into-"
+            <> mangleBranchName mergeSourceAndTarget.alice.branch
 
-    mangle :: ProjectBranchName -> Text
-    mangle =
-      Text.Builder.run . mangleB
-
-    mangleB :: ProjectBranchName -> Text.Builder
-    mangleB name =
+    mangleMergeSource :: MergeSource -> Text.Builder
+    mangleMergeSource = \case
+      MergeSource'LocalProjectBranch (ProjectAndBranch _project branch) -> mangleBranchName branch
+      MergeSource'RemoteProjectBranch (ProjectAndBranch _project branch) -> "remote-" <> mangleBranchName branch
+      MergeSource'RemoteLooseCode info -> manglePath info.path
+      MergeSource'RemoteGitRepo info -> manglePath info.path
+    mangleBranchName :: ProjectBranchName -> Text.Builder
+    mangleBranchName name =
       case classifyProjectBranchName name of
-        ProjectBranchNameKind'Contributor user name1 -> Text.Builder.text user <> Text.Builder.char '-' <> mangleB name1
+        ProjectBranchNameKind'Contributor user name1 ->
+          Text.Builder.text user
+            <> Text.Builder.char '-'
+            <> mangleBranchName name1
         ProjectBranchNameKind'DraftRelease semver -> "releases-drafts-" <> mangleSemver semver
         ProjectBranchNameKind'Release semver -> "releases-" <> mangleSemver semver
         ProjectBranchNameKind'NothingSpecial -> Text.Builder.text (into @Text name)
 
+    manglePath :: Path -> Text.Builder
+    manglePath =
+      Monoid.intercalateMap "-" (Text.Builder.text . NameSegment.toUnescapedText) . Path.toList
+
     mangleSemver :: Semver -> Text.Builder
     mangleSemver (Semver x y z) =
       Text.Builder.decimal x
@@ -781,141 +878,54 @@ findTemporaryBranchName info = do
         <> Text.Builder.char '.'
         <> Text.Builder.decimal z
 
--- Load namespace info into memory.
---
--- Fails if:
---   * One name is associated with more than one reference.
-loadNamespaceInfo ::
-  (forall void. Merge.PreconditionViolation -> Transaction void) ->
-  MergeDatabase ->
-  V2.Branch Transaction ->
-  Transaction (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
-loadNamespaceInfo abort db branch = do
-  defns <- loadNamespaceInfo0 (referent2to1 db) branch
-  assertNamespaceHasNoConflictedNames defns & onLeft abort
-
--- | Load all "namespace definitions" of a branch, which are all terms and type declarations *except* those defined
+-- Load all "namespace definitions" of a branch, which are all terms and type declarations *except* those defined
 -- in the "lib" namespace.
-loadNamespaceInfo0 ::
+--
+-- Fails if there is a conflicted name.
+loadNamespaceDefinitions ::
+  forall m.
   Monad m =>
   (V2.Referent -> m Referent) ->
   V2.Branch m ->
-  m (Nametree (DefnsF2 (Map NameSegment) Set Referent TypeReference))
-loadNamespaceInfo0 referent2to1 branch = do
-  terms <-
-    branch.terms
-      & Map.map Map.keysSet
-      & traverse (Set.traverse referent2to1)
-  let types = Map.map Map.keysSet branch.types
-  children <-
-    for (Map.delete NameSegment.libSegment branch.children) \childCausal -> do
-      childBranch <- childCausal.value
-      loadNamespaceInfo0_ referent2to1 childBranch
-  pure Nametree {value = Defns {terms, types}, children}
+  m (Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
+loadNamespaceDefinitions referent2to1 =
+  fmap assertNamespaceHasNoConflictedNames . go (Map.delete NameSegment.libSegment)
+  where
+    go ::
+      (forall x. Map NameSegment x -> Map NameSegment x) ->
+      V2.Branch m ->
+      m (Nametree (DefnsF2 (Map NameSegment) NESet Referent TypeReference))
+    go f branch = do
+      terms <- for branch.terms (fmap (Set.NonEmpty.fromList . List.NonEmpty.fromList) . traverse referent2to1 . Map.keys)
+      let types = Map.map (Set.NonEmpty.unsafeFromSet . Map.keysSet) branch.types
+      children <-
+        for (f branch.children) \childCausal -> do
+          child <- childCausal.value
+          go id child
+      pure Nametree {value = Defns {terms, types}, children}
 
-loadNamespaceInfo0_ ::
-  (Monad m) =>
-  (V2.Referent -> m Referent) ->
-  V2.Branch m ->
-  m (Nametree (DefnsF2 (Map NameSegment) Set Referent TypeReference))
-loadNamespaceInfo0_ referent2to1 branch = do
-  terms <-
-    branch.terms
-      & Map.map Map.keysSet
-      & traverse (Set.traverse referent2to1)
-  let types = Map.map Map.keysSet branch.types
-  children <-
-    for branch.children \childCausal -> do
-      childBranch <- childCausal.value
-      loadNamespaceInfo0_ referent2to1 childBranch
-  pure Nametree {value = Defns {terms, types}, children}
+data ConflictedName
+  = ConflictedName'Term !Name !(NESet Referent)
+  | ConflictedName'Type !Name !(NESet TypeReference)
 
 -- | Assert that there are no unconflicted names in a namespace.
 assertNamespaceHasNoConflictedNames ::
-  Nametree (DefnsF2 (Map NameSegment) Set Referent TypeReference) ->
-  Either Merge.PreconditionViolation (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
+  Nametree (DefnsF2 (Map NameSegment) NESet Referent TypeReference) ->
+  Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
 assertNamespaceHasNoConflictedNames =
   traverseNametreeWithName \names defns -> do
     terms <-
       defns.terms & Map.traverseWithKey \name ->
-        assertUnconflicted (Merge.ConflictedTermName (Name.fromReverseSegments (name :| names)))
+        assertUnconflicted (ConflictedName'Term (Name.fromReverseSegments (name :| names)))
     types <-
       defns.types & Map.traverseWithKey \name ->
-        assertUnconflicted (Merge.ConflictedTypeName (Name.fromReverseSegments (name :| names)))
+        assertUnconflicted (ConflictedName'Type (Name.fromReverseSegments (name :| names)))
     pure Defns {terms, types}
   where
-    assertUnconflicted :: (Set ref -> Merge.PreconditionViolation) -> Set ref -> Either Merge.PreconditionViolation ref
-    assertUnconflicted conflicted refs =
-      case Set.asSingleton refs of
-        Nothing -> Left (conflicted refs)
-        Just ref -> Right ref
-
--- Convert a merge precondition violation to an output message.
-mergePreconditionViolationToOutput :: Merge.PreconditionViolation -> Output.Output
-mergePreconditionViolationToOutput = \case
-  Merge.ConflictedAliases branch name1 name2 -> Output.MergeConflictedAliases branch name1 name2
-  Merge.ConflictedTermName name refs -> Output.MergeConflictedTermName name refs
-  Merge.ConflictedTypeName name refs -> Output.MergeConflictedTypeName name refs
-  Merge.ConflictInvolvingBuiltin name -> Output.MergeConflictInvolvingBuiltin name
-  Merge.ConstructorAlias maybeBranch name1 name2 -> Output.MergeConstructorAlias maybeBranch name1 name2
-  Merge.DefnsInLib -> Output.MergeDefnsInLib
-  Merge.MissingConstructorName name -> Output.MergeMissingConstructorName name
-  Merge.NestedDeclAlias shorterName longerName -> Output.MergeNestedDeclAlias shorterName longerName
-  Merge.StrayConstructor name -> Output.MergeStrayConstructor name
-
--- Assert that a namespace satisfies a few preconditions.
---
--- Fails if:
---   * The "lib" namespace contains any top-level terms or decls. (Only child namespaces are expected here).
---   * Any type declarations are "incoherent" (see `checkDeclCoherency`)
-assertNamespaceSatisfiesPreconditions ::
-  MergeDatabase ->
-  (forall void. Merge.PreconditionViolation -> Transaction void) ->
-  Maybe ProjectBranchName ->
-  V2.Branch Transaction ->
-  Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
-  Transaction (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name), DeclNameLookup)
-assertNamespaceSatisfiesPreconditions db abort maybeBranchName branch defns = do
-  whenJust (Map.lookup NameSegment.libSegment branch.children) \libdepsCausal -> do
-    libdepsBranch <- libdepsCausal.value
-    when (not (Map.null libdepsBranch.terms) || not (Map.null libdepsBranch.types)) do
-      abort Merge.DefnsInLib
-
-  declNameLookup <-
-    checkDeclCoherency db.loadDeclNumConstructors defns
-      & onLeftM (abort . incoherentDeclReasonToMergePreconditionViolation)
-
-  pure
-    ( Defns
-        { terms = flattenNametree (view #terms) defns,
-          types = flattenNametree (view #types) defns
-        },
-      declNameLookup
-    )
-  where
-    incoherentDeclReasonToMergePreconditionViolation :: IncoherentDeclReason -> Merge.PreconditionViolation
-    incoherentDeclReasonToMergePreconditionViolation = \case
-      IncoherentDeclReason'ConstructorAlias firstName secondName ->
-        Merge.ConstructorAlias maybeBranchName firstName secondName
-      IncoherentDeclReason'MissingConstructorName name -> Merge.MissingConstructorName name
-      IncoherentDeclReason'NestedDeclAlias shorterName longerName -> Merge.NestedDeclAlias shorterName longerName
-      IncoherentDeclReason'StrayConstructor name -> Merge.StrayConstructor name
-
-findOneConflictedAlias ::
-  TwoWay ProjectBranch ->
-  Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
-  TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) ->
-  Maybe Merge.PreconditionViolation
-findOneConflictedAlias projectBranchNames lcaDefns diffs =
-  aliceConflictedAliases <|> bobConflictedAliases
-  where
-    aliceConflictedAliases =
-      findConflictedAlias lcaDefns diffs.alice <&> \(name1, name2) ->
-        Merge.ConflictedAliases projectBranchNames.alice.name name1 name2
-
-    bobConflictedAliases =
-      findConflictedAlias lcaDefns diffs.bob <&> \(name1, name2) ->
-        Merge.ConflictedAliases projectBranchNames.bob.name name1 name2
+    assertUnconflicted :: (NESet ref -> ConflictedName) -> NESet ref -> Either ConflictedName ref
+    assertUnconflicted conflicted refs
+      | Set.NonEmpty.size refs == 1 = Right (Set.NonEmpty.findMin refs)
+      | otherwise = Left (conflicted refs)
 
 -- @findConflictedAlias namespace diff@, given an old namespace and a diff to a new namespace, will return the first
 -- "conflicted alias" encountered (if any), where a "conflicted alias" is a pair of names that referred to the same
@@ -935,8 +945,9 @@ findOneConflictedAlias projectBranchNames lcaDefns diffs =
 --
 -- This function currently doesn't return whether the conflicted alias is a decl or a term, but it certainly could.
 findConflictedAlias ::
-  Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
-  DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference ->
+  (Ord term, Ord typ) =>
+  Defns (BiMultimap term Name) (BiMultimap typ Name) ->
+  DefnsF3 (Map Name) DiffOp Synhashed term typ ->
   Maybe (Name, Name)
 findConflictedAlias defns diff =
   asum [go defns.terms diff.terms, go defns.types diff.types]

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

@@ -7,14 +7,17 @@ module Unison.Codebase.Editor.HandleInput.Pull
   )
 where
 
-import Control.Lens ((^.))
 import Control.Monad.Reader (ask)
 import Data.Text qualified as Text
 import Data.These
-import U.Codebase.Sqlite.Project qualified as Sqlite (Project)
-import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch)
+import U.Codebase.Branch qualified as V2.Branch
+import U.Codebase.Causal qualified
+import U.Codebase.Sqlite.Operations qualified as Operations
+import U.Codebase.Sqlite.Project qualified as Sqlite (Project (..))
+import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch (..))
 import U.Codebase.Sqlite.Queries qualified as Queries
 import Unison.Cli.DownloadUtils
+import Unison.Cli.MergeTypes (MergeSource (..))
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli
@@ -25,6 +28,7 @@ import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch (Branch (..))
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Branch.Merge qualified as Branch
+import Unison.Codebase.Editor.HandleInput.Merge2 (AliceMergeInfo (..), BobMergeInfo (..), LcaMergeInfo (..), MergeInfo (..), doMerge)
 import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper)
 import Unison.Codebase.Editor.Input
 import Unison.Codebase.Editor.Input qualified as Input
@@ -37,7 +41,6 @@ import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
 import Unison.Codebase.Patch (Patch (..))
 import Unison.Codebase.Path (Path')
 import Unison.Codebase.Path qualified as Path
-import Unison.Codebase.Verbosity qualified as Verbosity
 import Unison.CommandLine.InputPattern qualified as InputPattern
 import Unison.CommandLine.InputPatterns qualified as InputPatterns
 import Unison.NameSegment qualified as NameSegment
@@ -45,75 +48,112 @@ import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectBranchNameOrLatestRelease (..), ProjectName)
 import Witch (unsafeFrom)
 
-handlePull :: PullSourceTarget -> PullMode -> Verbosity.Verbosity -> Cli ()
-handlePull unresolvedSourceAndTarget pullMode verbosity = do
+handlePull :: PullSourceTarget -> PullMode -> Cli ()
+handlePull unresolvedSourceAndTarget pullMode = do
   let includeSquashed = case pullMode of
         Input.PullWithHistory -> Share.NoSquashedHead
         Input.PullWithoutHistory -> Share.IncludeSquashedHead
+
   (source, target) <- resolveSourceAndTarget includeSquashed unresolvedSourceAndTarget
-  remoteBranchObject <- do
+
+  remoteCausalHash <- do
     Cli.Env {codebase} <- ask
-    causalHash <-
-      case source of
-        ReadRemoteNamespaceGit repo -> do
-          downloadLooseCodeFromGitRepo
-            codebase
-            ( case pullMode of
-                Input.PullWithHistory -> GitNamespaceHistoryTreatment'LetAlone
-                Input.PullWithoutHistory -> GitNamespaceHistoryTreatment'DiscardAllHistory
-            )
-            repo
-            & onLeftM (Cli.returnEarly . Output.GitError)
-        ReadShare'LooseCode repo -> downloadLooseCodeFromShare repo & onLeftM (Cli.returnEarly . Output.ShareError)
-        ReadShare'ProjectBranch remoteBranch ->
-          downloadProjectBranchFromShare
-            ( case pullMode of
-                Input.PullWithHistory -> Share.NoSquashedHead
-                Input.PullWithoutHistory -> Share.IncludeSquashedHead
-            )
-            remoteBranch
-            & onLeftM (Cli.returnEarly . Output.ShareError)
-    liftIO (Codebase.expectBranchForHash codebase causalHash)
-  when (Branch.isEmpty0 (Branch.head remoteBranchObject)) do
-    Cli.respond (PulledEmptyBranch source)
-  targetAbsolutePath <-
-    case target of
-      Left path -> Cli.resolvePath' path
-      Right (ProjectAndBranch project branch) ->
-        pure $ ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))
+    case source of
+      ReadRemoteNamespaceGit repo -> do
+        downloadLooseCodeFromGitRepo
+          codebase
+          ( case pullMode of
+              Input.PullWithHistory -> GitNamespaceHistoryTreatment'LetAlone
+              Input.PullWithoutHistory -> GitNamespaceHistoryTreatment'DiscardAllHistory
+          )
+          repo
+          & onLeftM (Cli.returnEarly . Output.GitError)
+      ReadShare'LooseCode repo -> downloadLooseCodeFromShare repo & onLeftM (Cli.returnEarly . Output.ShareError)
+      ReadShare'ProjectBranch remoteBranch ->
+        downloadProjectBranchFromShare
+          ( case pullMode of
+              Input.PullWithHistory -> Share.NoSquashedHead
+              Input.PullWithoutHistory -> Share.IncludeSquashedHead
+          )
+          remoteBranch
+          & onLeftM (Cli.returnEarly . Output.ShareError)
+
+  remoteBranchIsEmpty <-
+    Cli.runTransaction do
+      causal <- Operations.expectCausalBranchByCausalHash remoteCausalHash
+      branch <- causal.value
+      V2.Branch.isEmpty branch
+
+  when remoteBranchIsEmpty (Cli.respond (PulledEmptyBranch source))
+
+  let targetAbsolutePath =
+        ProjectUtils.projectBranchPath (ProjectAndBranch target.project.projectId target.branch.branchId)
+
   let description =
         Text.unwords
           [ Text.pack . InputPattern.patternName $
               case pullMode of
                 PullWithoutHistory -> InputPatterns.pullWithoutHistory
                 PullWithHistory -> InputPatterns.pull,
-            printReadRemoteNamespace (\remoteBranch -> into @Text (ProjectAndBranch (remoteBranch ^. #projectName) (remoteBranch ^. #branchName))) source,
+            printReadRemoteNamespace (\remoteBranch -> into @Text (ProjectAndBranch remoteBranch.projectName remoteBranch.branchName)) source,
             case target of
-              Left path -> Path.toText' path
-              Right (ProjectAndBranch project branch) -> into @Text (ProjectAndBranch (project ^. #name) (branch ^. #name))
+              ProjectAndBranch project branch -> into @Text (ProjectAndBranch project.name branch.name)
           ]
+
   case pullMode of
     Input.PullWithHistory -> do
       targetBranchObject <- Cli.getBranch0At targetAbsolutePath
+
       if Branch.isEmpty0 targetBranchObject
         then do
+          Cli.Env {codebase} <- ask
+          remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase remoteCausalHash)
           void $ Cli.updateAtM description targetAbsolutePath (const $ pure remoteBranchObject)
           Cli.respond $ MergeOverEmpty target
         else do
           Cli.respond AboutToMerge
-          mergeBranchAndPropagateDefaultPatch
-            Branch.RegularMerge
-            description
-            (Just (PullAlreadyUpToDate source target))
-            remoteBranchObject
-            (if Verbosity.isSilent verbosity then Nothing else Just target)
-            targetAbsolutePath
+
+          aliceCausalHash <-
+            Cli.runTransaction do
+              causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute targetAbsolutePath)
+              pure causal.causalHash
+
+          lcaCausalHash <- Cli.runTransaction (Operations.lca aliceCausalHash remoteCausalHash)
+
+          doMerge
+            MergeInfo
+              { alice =
+                  AliceMergeInfo
+                    { causalHash = aliceCausalHash,
+                      project = target.project,
+                      projectBranch = target.branch
+                    },
+                bob =
+                  BobMergeInfo
+                    { causalHash = remoteCausalHash,
+                      source =
+                        case source of
+                          ReadShare'ProjectBranch remoteBranch ->
+                            MergeSource'RemoteProjectBranch (ProjectAndBranch remoteBranch.projectName remoteBranch.branchName)
+                          ReadShare'LooseCode info -> MergeSource'RemoteLooseCode info
+                          ReadRemoteNamespaceGit info -> MergeSource'RemoteGitRepo info
+                    },
+                lca =
+                  LcaMergeInfo
+                    { causalHash = lcaCausalHash
+                    },
+                description
+              }
     Input.PullWithoutHistory -> do
+      Cli.Env {codebase} <- ask
+      remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase remoteCausalHash)
+
       didUpdate <-
         Cli.updateAtM
           description
           targetAbsolutePath
           (\targetBranchObject -> pure $ remoteBranchObject `Branch.consBranchSnapshot` targetBranchObject)
+
       Cli.respond
         if didUpdate
           then PullSuccessful source target
@@ -124,13 +164,19 @@ resolveSourceAndTarget ::
   PullSourceTarget ->
   Cli
     ( ReadRemoteNamespace Share.RemoteProjectBranch,
-      Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
+      ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch
     )
 resolveSourceAndTarget includeSquashed = \case
   Input.PullSourceTarget0 -> liftA2 (,) (resolveImplicitSource includeSquashed) resolveImplicitTarget
   Input.PullSourceTarget1 source -> liftA2 (,) (resolveExplicitSource includeSquashed source) resolveImplicitTarget
   Input.PullSourceTarget2 source target ->
-    liftA2 (,) (resolveExplicitSource includeSquashed source) (ProjectUtils.expectLooseCodeOrProjectBranch target)
+    liftA2
+      (,)
+      (resolveExplicitSource includeSquashed source)
+      ( ProjectUtils.expectProjectAndBranchByTheseNames case target of
+          ProjectAndBranch Nothing branch -> That branch
+          ProjectAndBranch (Just project) branch -> These project branch
+      )
 
 resolveImplicitSource :: Share.IncludeSquashedHead -> Cli (ReadRemoteNamespace Share.RemoteProjectBranch)
 resolveImplicitSource includeSquashed =
@@ -139,8 +185,8 @@ resolveImplicitSource includeSquashed =
     Just (localProjectAndBranch, _restPath) -> do
       (remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) <-
         Cli.runTransactionWithRollback \rollback -> do
-          let localProjectId = localProjectAndBranch ^. #project . #projectId
-          let localBranchId = localProjectAndBranch ^. #branch . #branchId
+          let localProjectId = localProjectAndBranch.project.projectId
+          let localBranchId = localProjectAndBranch.branch.branchId
           Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId >>= \case
             Just (remoteProjectId, Just remoteBranchId) -> do
               remoteProjectName <- Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri
@@ -167,7 +213,7 @@ resolveExplicitSource includeSquashed = \case
   ReadShare'LooseCode namespace -> pure (ReadShare'LooseCode namespace)
   ReadShare'ProjectBranch (This remoteProjectName) -> do
     remoteProject <- ProjectUtils.expectRemoteProjectByName remoteProjectName
-    let remoteProjectId = remoteProject ^. #projectId
+    let remoteProjectId = remoteProject.projectId
     let remoteBranchName = unsafeFrom @Text "main"
     remoteProjectBranch <-
       ProjectUtils.expectRemoteProjectBranchByName
@@ -176,8 +222,8 @@ resolveExplicitSource includeSquashed = \case
     pure (ReadShare'ProjectBranch remoteProjectBranch)
   ReadShare'ProjectBranch (That branchNameOrLatestRelease) -> do
     (ProjectAndBranch localProject localBranch, _restPath) <- ProjectUtils.expectCurrentProjectBranch
-    let localProjectId = localProject ^. #projectId
-    let localBranchId = localBranch ^. #branchId
+    let localProjectId = localProject.projectId
+    let localBranchId = localBranch.branchId
     Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case
       Just (remoteProjectId, _maybeProjectBranchId) -> do
         remoteProjectName <- Cli.runTransaction (Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri)
@@ -196,10 +242,10 @@ resolveExplicitSource includeSquashed = \case
         Cli.returnEarly $
           Output.NoAssociatedRemoteProject
             Share.hardCodedUri
-            (ProjectAndBranch (localProject ^. #name) (localBranch ^. #name))
+            (ProjectAndBranch localProject.name localBranch.name)
   ReadShare'ProjectBranch (These projectName branchNameOrLatestRelease) -> do
     remoteProject <- ProjectUtils.expectRemoteProjectByName projectName
-    let remoteProjectId = remoteProject ^. #projectId
+    let remoteProjectId = remoteProject.projectId
     branchName <-
       case branchNameOrLatestRelease of
         ProjectBranchNameOrLatestRelease'Name name -> pure name
@@ -210,11 +256,10 @@ resolveExplicitSource includeSquashed = \case
         (ProjectAndBranch (remoteProjectId, projectName) branchName)
     pure (ReadShare'ProjectBranch remoteProjectBranch)
 
-resolveImplicitTarget :: Cli (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
-resolveImplicitTarget =
-  ProjectUtils.getCurrentProjectBranch <&> \case
-    Nothing -> Left Path.currentPath
-    Just (projectAndBranch, _restPath) -> Right projectAndBranch
+resolveImplicitTarget :: Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
+resolveImplicitTarget = do
+  (projectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch
+  pure projectAndBranch
 
 -- | supply `dest0` if you want to print diff messages
 --   supply unchangedMessage if you want to display it if merge had no effect

unison-cli/src/Unison/Codebase/Editor/Input.hs

@@ -41,7 +41,6 @@ import Unison.Codebase.Path.Parse qualified as Path
 import Unison.Codebase.PushBehavior (PushBehavior)
 import Unison.Codebase.ShortCausalHash (ShortCausalHash)
 import Unison.Codebase.ShortCausalHash qualified as SCH
-import Unison.Codebase.Verbosity (Verbosity)
 import Unison.CommandLine.BranchRelativePath (BranchRelativePath, parseBranchRelativePath)
 import Unison.HashQualified qualified as HQ
 import Unison.Name (Name)
@@ -114,7 +113,7 @@ data Input
     MergeLocalBranchI LooseCodeOrProject LooseCodeOrProject Branch.MergeMode
   | PreviewMergeLocalBranchI LooseCodeOrProject LooseCodeOrProject
   | DiffNamespaceI BranchId BranchId -- old new
-  | PullRemoteBranchI PullSourceTarget PullMode Verbosity
+  | PullI !PullSourceTarget !PullMode
   | PushRemoteBranchI PushRemoteBranchInput
   | ResetRootI (Either ShortCausalHash Path')
   | ResetI
@@ -198,7 +197,6 @@ data Input
   | StructuredFindReplaceI (HQ.HashQualified Name) -- sfind.replace rewriteQuery
   | -- Show provided definitions.
     ShowDefinitionI OutputLocation ShowDefinitionScope (NonEmpty (HQ.HashQualified Name))
-  | ShowDefinitionByPrefixI OutputLocation [HQ.HashQualified Name]
   | ShowReflogI
   | UpdateBuiltinsI
   | MergeBuiltinsI (Maybe Path)
@@ -276,7 +274,7 @@ data GistInput = GistInput
 data PullSourceTarget
   = PullSourceTarget0
   | PullSourceTarget1 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease))
-  | PullSourceTarget2 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) LooseCodeOrProject
+  | PullSourceTarget2 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
   deriving stock (Eq, Show)
 
 data PushSource

unison-cli/src/Unison/Codebase/Editor/Output.hs

@@ -28,6 +28,7 @@ import U.Codebase.HashTags (CausalHash)
 import U.Codebase.Sqlite.Project qualified as Sqlite
 import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
 import Unison.Auth.Types (CredentialFailure)
+import Unison.Cli.MergeTypes (MergeSourceOrTarget, MergeSourceAndTarget)
 import Unison.Cli.Share.Projects.Types qualified as Share
 import Unison.Codebase.Editor.Input
 import Unison.Codebase.Editor.Output.BranchDiff (BranchDiffOutput)
@@ -62,7 +63,7 @@ import Unison.Prelude
 import Unison.PrettyPrintEnv qualified as PPE
 import Unison.PrettyPrintEnvDecl qualified as PPE
 import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName, Semver)
-import Unison.Reference (Reference, TermReferenceId)
+import Unison.Reference (Reference, TermReferenceId, TypeReference)
 import Unison.Reference qualified as Reference
 import Unison.Referent (Referent)
 import Unison.Server.Backend (ShallowListEntry (..))
@@ -283,16 +284,18 @@ data Output
   | ShowReflog [(Maybe UTCTime, SCH.ShortCausalHash, Text)]
   | PullAlreadyUpToDate
       (ReadRemoteNamespace Share.RemoteProjectBranch)
-      (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
+      (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
   | PullSuccessful
       (ReadRemoteNamespace Share.RemoteProjectBranch)
-      (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
+      (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
   | AboutToMerge
   | -- | Indicates a trivial merge where the destination was empty and was just replaced.
-    MergeOverEmpty (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
+    MergeOverEmpty (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
   | MergeAlreadyUpToDate
-      (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
-      (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
+      (Either Path' (ProjectAndBranch ProjectName ProjectBranchName))
+      (Either Path' (ProjectAndBranch ProjectName ProjectBranchName))
+  | -- This will replace the above once `merge.old` is deleted
+    MergeAlreadyUpToDate2 !MergeSourceAndTarget
   | PreviewMergeAlreadyUpToDate
       (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
       (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
@@ -395,19 +398,18 @@ data Output
   | UpgradeFailure !FilePath !NameSegment !NameSegment
   | UpgradeSuccess !NameSegment !NameSegment
   | LooseCodePushDeprecated
-  | MergeFailure !FilePath !(ProjectAndBranch ProjectName ProjectBranchName) !(ProjectAndBranch ProjectName ProjectBranchName)
-  | MergeSuccess !(ProjectAndBranch ProjectName ProjectBranchName) !(ProjectAndBranch ProjectName ProjectBranchName)
-  | MergeSuccessFastForward !(ProjectAndBranch ProjectName ProjectBranchName) !(ProjectAndBranch ProjectName ProjectBranchName)
-  | -- These are all merge precondition violations. See PreconditionViolation for more docs.
-    MergeConflictedAliases !ProjectBranchName !Name !Name
-  | MergeConflictedTermName !Name !(Set Referent)
-  | MergeConflictedTypeName !Name !(Set Reference.TypeReference)
+  | MergeFailure !FilePath !MergeSourceAndTarget
+  | MergeSuccess !MergeSourceAndTarget
+  | MergeSuccessFastForward !MergeSourceAndTarget
+  | MergeConflictedAliases !MergeSourceOrTarget !Name !Name
+  | MergeConflictedTermName !Name !(NESet Referent)
+  | MergeConflictedTypeName !Name !(NESet TypeReference)
   | MergeConflictInvolvingBuiltin !Name
-  | MergeConstructorAlias !(Maybe ProjectBranchName) !Name !Name
-  | MergeDefnsInLib
-  | MergeMissingConstructorName !Name
-  | MergeNestedDeclAlias !Name !Name
-  | MergeStrayConstructor !Name
+  | MergeConstructorAlias !(Maybe MergeSourceOrTarget) !Name !Name
+  | MergeDefnsInLib !MergeSourceOrTarget
+  | MergeMissingConstructorName !(Maybe MergeSourceOrTarget) !Name
+  | MergeNestedDeclAlias !(Maybe MergeSourceOrTarget) !Name !Name
+  | MergeStrayConstructor !(Maybe MergeSourceOrTarget) !Name
   | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment
 
 data UpdateOrUpgrade = UOUUpdate | UOUUpgrade
@@ -560,6 +562,7 @@ isFailure o = case o of
   AboutToMerge {} -> False
   MergeOverEmpty {} -> False
   MergeAlreadyUpToDate {} -> False
+  MergeAlreadyUpToDate2 {} -> False
   PreviewMergeAlreadyUpToDate {} -> False
   NoConflictsOrEdits {} -> False
   ListShallow _ es -> null es
@@ -646,7 +649,7 @@ isFailure o = case o of
   MergeConflictedTypeName {} -> True
   MergeConflictInvolvingBuiltin {} -> True
   MergeConstructorAlias {} -> True
-  MergeDefnsInLib -> True
+  MergeDefnsInLib {} -> True
   MergeMissingConstructorName {} -> True
   MergeNestedDeclAlias {} -> True
   MergeStrayConstructor {} -> True

unison-cli/src/Unison/Codebase/Editor/UriParser.hs

@@ -61,10 +61,9 @@ type P = P.Parsec Void Text.Text
 
 readRemoteNamespaceParser :: ProjectBranchSpecifier branch -> P (ReadRemoteNamespace (These ProjectName branch))
 readRemoteNamespaceParser specifier =
-  P.label "generic repo" $
-    ReadRemoteNamespaceGit <$> readGitRemoteNamespace
-      <|> ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier
-      <|> ReadShare'LooseCode <$> readShareLooseCode
+  ReadRemoteNamespaceGit <$> readGitRemoteNamespace
+    <|> ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier
+    <|> ReadShare'LooseCode <$> readShareLooseCode
 
 projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths ::
   ProjectBranchSpecifier branch ->
@@ -109,7 +108,7 @@ writeShareRemoteNamespace =
 -- >>> P.parseMaybe readShareLooseCode ".unisonweb.base._releases.M4"
 -- >>> P.parseMaybe readShareLooseCode "unisonweb.base._releases.M4"
 -- Nothing
--- Just (ReadShareLooseCode {server = ShareRepo, repo = "unisonweb", path = base._releases.M4})
+-- Just (ReadShareLooseCode {server = DefaultCodeserver, repo = ShareUserHandle {shareUserHandleToText = "unisonweb"}, path = base._releases.M4})
 readShareLooseCode :: P ReadShareLooseCode
 readShareLooseCode = do
   P.label "read share loose code" $

unison-cli/src/Unison/CommandLine/InputPatterns.hs

@@ -2,7 +2,150 @@
    This module defines 'InputPattern' values for every supported input command.
 -}
 
-module Unison.CommandLine.InputPatterns where
+module Unison.CommandLine.InputPatterns
+  ( -- * Input commands
+    add,
+    aliasMany,
+    aliasTerm,
+    aliasType,
+    api,
+    authLogin,
+    back,
+    branchEmptyInputPattern,
+    branchInputPattern,
+    branchRenameInputPattern,
+    branchesInputPattern,
+    cd,
+    clear,
+    clone,
+    compileScheme,
+    copyPatch,
+    createAuthor,
+    debugClearWatchCache,
+    debugDoctor,
+    debugDumpNamespace,
+    debugDumpNamespaceSimple,
+    debugFileHashes,
+    debugFormat,
+    debugFuzzyOptions,
+    debugLSPFoldRanges,
+    debugNameDiff,
+    debugNumberedArgs,
+    debugTabCompletion,
+    debugTerm,
+    debugTermVerbose,
+    debugType,
+    delete,
+    deleteBranch,
+    deleteNamespace,
+    deleteNamespaceForce,
+    deletePatch,
+    deleteProject,
+    deleteTerm,
+    deleteTermReplacement,
+    deleteTermVerbose,
+    deleteType,
+    deleteTypeReplacement,
+    deleteTypeVerbose,
+    deleteVerbose,
+    dependencies,
+    dependents,
+    diffNamespace,
+    diffNamespaceToPatch,
+    display,
+    displayTo,
+    docToMarkdown,
+    docs,
+    docsToHtml,
+    edit,
+    editNamespace,
+    execute,
+    find,
+    findAll,
+    findGlobal,
+    findIn,
+    findInAll,
+    findPatch,
+    findShallow,
+    findVerbose,
+    findVerboseAll,
+    forkLocal,
+    gist,
+    help,
+    helpTopics,
+    history,
+    ioTest,
+    ioTestAll,
+    libInstallInputPattern,
+    load,
+    makeStandalone,
+    mergeBuiltins,
+    mergeIOBuiltins,
+    mergeInputPattern,
+    mergeOldInputPattern,
+    mergeOldPreviewInputPattern,
+    mergeOldSquashInputPattern,
+    moveAll,
+    names,
+    namespaceDependencies,
+    patch,
+    previewAdd,
+    previewUpdate,
+    printVersion,
+    projectCreate,
+    projectCreateEmptyInputPattern,
+    projectRenameInputPattern,
+    projectSwitch,
+    projectsInputPattern,
+    pull,
+    pullWithoutHistory,
+    push,
+    pushCreate,
+    pushExhaustive,
+    pushForce,
+    quit,
+    releaseDraft,
+    renameBranch,
+    renamePatch,
+    renameTerm,
+    renameType,
+    replace,
+    reset,
+    resetRoot,
+    runScheme,
+    saveExecuteResult,
+    sfind,
+    sfindReplace,
+    test,
+    testAll,
+    todo,
+    ui,
+    undo,
+    up,
+    update,
+    updateBuiltins,
+    updateOld,
+    updateOldNoPatch,
+    upgrade,
+    view,
+    viewGlobal,
+    viewPatch,
+    viewReflog,
+
+    -- * Misc
+    deleteTermReplacementCommand,
+    deleteTypeReplacementCommand,
+    helpFor,
+    makeExample',
+    makeExample,
+    makeExampleEOS,
+    makeExampleNoBackticks,
+    patternMap,
+    patternName,
+    showPatternHelp,
+    validInputs,
+  )
+where
 
 import Control.Lens (preview, review, (^.))
 import Control.Lens.Cons qualified as Cons
@@ -11,7 +154,6 @@ import Data.List.Extra qualified as List
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as Map
 import Data.Maybe (fromJust)
-import Data.Proxy (Proxy (..))
 import Data.Set qualified as Set
 import Data.Text qualified as Text
 import Data.These (These (..))
@@ -21,7 +163,7 @@ import System.Console.Haskeline.Completion qualified as Haskeline
 import System.Console.Haskeline.Completion qualified as Line
 import Text.Megaparsec qualified as Megaparsec
 import Text.Megaparsec.Internal qualified as Megaparsec (withParsecT)
-import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId)
+import U.Codebase.Sqlite.DbId (ProjectBranchId)
 import U.Codebase.Sqlite.Project qualified as Sqlite
 import U.Codebase.Sqlite.Queries qualified as Queries
 import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
@@ -34,15 +176,13 @@ import Unison.Codebase.Editor.Input (DeleteOutput (..), DeleteTarget (..), Input
 import Unison.Codebase.Editor.Input qualified as Input
 import Unison.Codebase.Editor.Output.PushPull (PushPull (Pull, Push))
 import Unison.Codebase.Editor.Output.PushPull qualified as PushPull
-import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteGitRepo, WriteRemoteNamespace)
+import Unison.Codebase.Editor.RemoteRepo (WriteGitRepo, WriteRemoteNamespace)
 import Unison.Codebase.Editor.SlurpResult qualified as SR
 import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser)
 import Unison.Codebase.Editor.UriParser qualified as UriParser
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Path.Parse qualified as Path
 import Unison.Codebase.PushBehavior qualified as PushBehavior
-import Unison.Codebase.Verbosity (Verbosity)
-import Unison.Codebase.Verbosity qualified as Verbosity
 import Unison.CommandLine
 import Unison.CommandLine.BranchRelativePath (parseBranchRelativePath, parseIncrementalBranchRelativePath)
 import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath
@@ -64,6 +204,7 @@ import Unison.Project
     ProjectBranchSpecifier (..),
     ProjectName,
     Semver,
+    branchWithOptionalProjectParser,
   )
 import Unison.Project.Util (ProjectContext (..), projectContextFromPath)
 import Unison.Syntax.HashQualified qualified as HQ (parseText)
@@ -72,6 +213,7 @@ import Unison.Syntax.NameSegment qualified as NameSegment (renderParseErr, segme
 import Unison.Util.ColorText qualified as CT
 import Unison.Util.Monoid (intercalateMap)
 import Unison.Util.Pretty qualified as P
+import Unison.Util.Pretty.MegaParsec (prettyPrintParseError)
 
 showPatternHelp :: InputPattern -> P.Pretty CT.ColorText
 showPatternHelp i =
@@ -97,8 +239,7 @@ makeExampleNoBackticks p args =
 makeExample' :: InputPattern -> P.Pretty CT.ColorText
 makeExample' p = makeExample p []
 
-makeExampleEOS ::
-  InputPattern -> [P.Pretty CT.ColorText] -> P.Pretty CT.ColorText
+makeExampleEOS :: InputPattern -> [P.Pretty CT.ColorText] -> P.Pretty CT.ColorText
 makeExampleEOS p args =
   P.group $
     backtick (intercalateMap " " id (P.nonEmpty $ fromString (I.patternName p) : args)) <> "."
@@ -532,18 +673,6 @@ undo =
     "`undo` reverts the most recent change to the codebase."
     (const $ pure Input.UndoI)
 
-viewByPrefix :: InputPattern
-viewByPrefix =
-  InputPattern
-    "view.recursive"
-    []
-    I.Visible
-    [("definition to view", OnePlus, definitionQueryArg)]
-    "`view.recursive Foo` prints the definitions of `Foo` and `Foo.blah`."
-    ( fmap (Input.ShowDefinitionByPrefixI Input.ConsoleLocation)
-        . traverse parseHashQualifiedName
-    )
-
 sfind :: InputPattern
 sfind =
   InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse
@@ -1330,22 +1459,18 @@ resetRoot =
 
 pull :: InputPattern
 pull =
-  pullImpl "pull" ["pull.silent"] Verbosity.Silent Input.PullWithHistory "without listing the merged entities"
-
-pullVerbose :: InputPattern
-pullVerbose = pullImpl "pull.verbose" [] Verbosity.Verbose Input.PullWithHistory "and lists the merged entities"
+  pullImpl "pull" [] Input.PullWithHistory ""
 
 pullWithoutHistory :: InputPattern
 pullWithoutHistory =
   pullImpl
     "pull.without-history"
     []
-    Verbosity.Silent
     Input.PullWithoutHistory
     "without including the remote's history. This usually results in smaller codebase sizes."
 
-pullImpl :: String -> [String] -> Verbosity -> Input.PullMode -> P.Pretty CT.ColorText -> InputPattern
-pullImpl name aliases verbosity pullMode addendum = do
+pullImpl :: String -> [String] -> Input.PullMode -> P.Pretty CT.ColorText -> InputPattern
+pullImpl name aliases pullMode addendum = do
   self
   where
     self =
@@ -1353,57 +1478,92 @@ pullImpl name aliases verbosity pullMode addendum = do
         { patternName = name,
           aliases = aliases,
           visibility = I.Visible,
-          args = [("remote location to pull", Optional, remoteNamespaceArg), ("destination namespace", Optional, namespaceArg)],
+          args =
+            [ ("remote namespace to pull", Optional, remoteNamespaceArg),
+              ( "destination branch",
+                Optional,
+                projectBranchNameArg
+                  ProjectBranchSuggestionsConfig
+                    { showProjectCompletions = False,
+                      projectInclusion = AllProjects,
+                      branchInclusion = AllBranches
+                    }
+              )
+            ],
           help =
             P.lines
               [ P.wrap $
                   "The"
                     <> makeExample' self
-                    <> "command merges a remote namespace into a local namespace"
+                    <> "command merges a remote namespace into a local branch"
                     <> addendum,
                 "",
                 P.wrapColumn2
                   [ ( makeExample self ["@unison/base/main"],
                       "merges the branch `main`"
                         <> "of the Unison Share hosted project `@unison/base`"
-                        <> "into the current namespace"
+                        <> "into the current branch"
                     ),
                     ( makeExample self ["@unison/base/main", "my-base/topic"],
                       "merges the branch `main`"
                         <> "of the Unison Share hosted project `@unison/base`"
                         <> "into the branch `topic` of the local `my-base` project"
-                    ),
-                    ( makeExample self ["remote", "local"],
-                      "merges the remote namespace `remote`"
-                        <> "into the local namespace `local"
-                    ),
-                    ( makeExample self ["remote"],
-                      "merges the remote namespace `remote`"
-                        <> "into the current namespace"
-                    ),
-                    ( makeExample' self,
-                      "merges the remote namespace configured in `.unisonConfig`"
-                        <> "at the key `RemoteMappings.<namespace>` where `<namespace>` is the current namespace,"
                     )
                   ],
                 "",
                 explainRemote Pull
               ],
-          parse =
-            maybeToEither (I.help self) . \case
-              [] -> Just $ Input.PullRemoteBranchI Input.PullSourceTarget0 pullMode verbosity
-              [sourceString] -> do
-                source <- parsePullSource (Text.pack sourceString)
-                Just $ Input.PullRemoteBranchI (Input.PullSourceTarget1 source) pullMode verbosity
-              [sourceString, targetString] -> do
-                source <- parsePullSource (Text.pack sourceString)
-                target <- parseLooseCodeOrProject targetString
-                Just $
-                  Input.PullRemoteBranchI
-                    (Input.PullSourceTarget2 source target)
-                    pullMode
-                    verbosity
-              _ -> Nothing
+          parse = \case
+            -- maybeToEither (I.help self) . \case
+            [] -> Right $ Input.PullI Input.PullSourceTarget0 pullMode
+            [sourceString] -> do
+              source <-
+                sourceString
+                  & Text.pack
+                  & megaparse (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease)
+                  & mapLeft (\err -> I.help self <> P.newline <> err)
+              Right $ Input.PullI (Input.PullSourceTarget1 source) pullMode
+            [sourceString, targetString] -> do
+              source <-
+                sourceString
+                  & Text.pack
+                  & megaparse (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease)
+                  & mapLeft (\err -> I.help self <> P.newline <> err)
+              target <-
+                targetString
+                  & Text.pack
+                  & megaparse branchWithOptionalProjectParser
+                  & mapLeft
+                    ( \err ->
+                        -- You used to be able to pull into a path. So if target parsing fails, but path parsing succeeds,
+                        -- explain that the command has changed. Furthermore, in the special case that the user is trying to
+                        -- pull into the `lib` namespace, suggest using `lib.install`.
+                        case Path.parsePath' targetString of
+                          Left _ -> I.help self <> P.newline <> err
+                          Right path ->
+                            I.help self
+                              <> P.newline
+                              <> P.newline
+                              <> P.newline
+                              <> let pullingIntoLib =
+                                       case path of
+                                         Path.RelativePath'
+                                           ( Path.Relative
+                                               (Path.toList -> lib : _)
+                                             ) -> lib == NameSegment.libSegment
+                                         _ -> False
+                                  in P.wrap $
+                                       "You may only"
+                                         <> makeExample' pull
+                                         <> "into a branch."
+                                         <> if pullingIntoLib
+                                           then
+                                             "Did you mean to run"
+                                               <> P.group (makeExample libInstallInputPattern [P.string sourceString] <> "?")
+                                           else mempty
+                    )
+              Right $ Input.PullI (Input.PullSourceTarget2 source target) pullMode
+            _ -> Left (I.help self)
         }
 
 debugTabCompletion :: InputPattern
@@ -1939,14 +2099,6 @@ topicNameArg =
           fzfResolver = Just $ Resolvers.fuzzySelectFromList (Text.pack <$> topics)
         }
 
-codebaseServerNameArg :: ArgumentType
-codebaseServerNameArg =
-  ArgumentType
-    { typeName = "codebase-server",
-      suggestions = \_ _ _ _ -> pure [],
-      fzfResolver = Nothing
-    }
-
 helpTopics :: InputPattern
 helpTopics =
   InputPattern
@@ -3090,7 +3242,6 @@ validInputs =
       projectSwitch,
       projectsInputPattern,
       pull,
-      pullVerbose,
       pullWithoutHistory,
       push,
       pushCreate,
@@ -3155,14 +3306,6 @@ exactDefinitionArg =
       fzfResolver = Just Resolvers.definitionResolver
     }
 
-fuzzyDefinitionQueryArg :: ArgumentType
-fuzzyDefinitionQueryArg =
-  ArgumentType
-    { typeName = "fuzzy definition query",
-      suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteTermOrType q p),
-      fzfResolver = Just Resolvers.definitionResolver
-    }
-
 definitionQueryArg :: ArgumentType
 definitionQueryArg = exactDefinitionArg {typeName = "definition query"}
 
@@ -3309,18 +3452,6 @@ data ProjectInclusion = OnlyWithinCurrentProject | OnlyOutsideCurrentProject | A
 data BranchInclusion = ExcludeCurrentBranch | AllBranches
   deriving stock (Eq, Ord, Show)
 
-projectsByPrefix :: MonadIO m => ProjectInclusion -> Codebase m v a -> Path.Absolute -> Text -> m [(ProjectId, ProjectName)]
-projectsByPrefix projectInclusion codebase path query = do
-  allProjectMatches <- Codebase.runTransaction codebase do
-    Queries.loadAllProjectsBeginningWith (Just query)
-      <&> map (\(Sqlite.Project projId projName) -> (projId, projName))
-  let projectCtx = projectContextFromPath path
-  pure $ case (projectCtx, projectInclusion) of
-    (_, AllProjects) -> allProjectMatches
-    (LooseCodePath {}, _) -> allProjectMatches
-    (ProjectBranchPath currentProjectId _branchId _path, OnlyWithinCurrentProject) -> allProjectMatches & filter \(projId, _) -> projId == currentProjectId
-    (ProjectBranchPath currentProjectId _branchId _path, OnlyOutsideCurrentProject) -> allProjectMatches & filter \(projId, _) -> projId /= currentProjectId
-
 data ProjectBranchSuggestionsConfig = ProjectBranchSuggestionsConfig
   { -- Whether projects (without branches) should be considered possible completions.
     showProjectCompletions :: Bool,
@@ -3682,15 +3813,6 @@ projectBranchNameArg config =
       fzfResolver = Just Resolvers.projectBranchResolver
     }
 
--- [project/]branch
-projectBranchNameWithOptionalProjectNameArg :: ArgumentType
-projectBranchNameWithOptionalProjectNameArg =
-  ArgumentType
-    { typeName = "project-branch-name-with-optional-project-name",
-      suggestions = \_ _ _ _ -> pure [],
-      fzfResolver = Just Resolvers.projectBranchResolver
-    }
-
 branchRelativePathArg :: ArgumentType
 branchRelativePathArg =
   ArgumentType
@@ -3746,10 +3868,6 @@ projectNameSuggestions slash (Text.strip . Text.pack -> input) codebase = do
                 isFinished = False
               }
 
-parsePullSource :: Text -> Maybe (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease))
-parsePullSource =
-  Megaparsec.parseMaybe (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease)
-
 -- | Parse a 'Input.PushSource'.
 parsePushSource :: String -> Either (P.Pretty CT.ColorText) Input.PushSource
 parsePushSource sourceStr =
@@ -3787,9 +3905,6 @@ parseWriteGitRepo label input = do
     (fromString . show) -- turn any parsing errors into a Pretty.
     (Megaparsec.parse (UriParser.writeGitRepo <* Megaparsec.eof) label (Text.pack input))
 
-collectNothings :: (a -> Maybe b) -> [a] -> [a]
-collectNothings f as = [a | (Nothing, a) <- map f as `zip` as]
-
 explainRemote :: PushPull -> P.Pretty CT.ColorText
 explainRemote pushPull =
   P.group $
@@ -3806,23 +3921,8 @@ explainRemote pushPull =
   where
     gitRepo = PushPull.fold @(P.Pretty P.ColorText) "git@github.com:" "https://github.com/" pushPull
 
-showErrorFancy :: (Megaparsec.ShowErrorComponent e) => Megaparsec.ErrorFancy e -> String
-showErrorFancy (Megaparsec.ErrorFail msg) = msg
-showErrorFancy (Megaparsec.ErrorIndentation ord ref actual) =
-  "incorrect indentation (got "
-    <> show (Megaparsec.unPos actual)
-    <> ", should be "
-    <> p
-    <> show (Megaparsec.unPos ref)
-    <> ")"
-  where
-    p = case ord of
-      LT -> "less than "
-      EQ -> "equal to "
-      GT -> "greater than "
-showErrorFancy (Megaparsec.ErrorCustom a) = Megaparsec.showErrorComponent a
-
-showErrorItem :: Megaparsec.ErrorItem (Megaparsec.Token Text) -> String
-showErrorItem (Megaparsec.Tokens ts) = Megaparsec.showTokens (Proxy @Text) ts
-showErrorItem (Megaparsec.Label label) = NE.toList label
-showErrorItem Megaparsec.EndOfInput = "end of input"
+megaparse :: Megaparsec.Parsec Void Text a -> Text -> Either (P.Pretty P.ColorText) a
+megaparse parser input =
+  input
+    & Megaparsec.parse (parser <* Megaparsec.eof) ""
+    & mapLeft (prettyPrintParseError (Text.unpack input))

unison-cli/src/Unison/CommandLine/OutputMessages.hs

@@ -38,9 +38,12 @@ import U.Codebase.Branch.Diff (NameChanges (..))
 import U.Codebase.HashTags (CausalHash (..))
 import U.Codebase.Reference qualified as Reference
 import U.Codebase.Sqlite.DbId (SchemaVersion (SchemaVersion))
+import U.Codebase.Sqlite.Project (Project (..))
+import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
 import Unison.ABT qualified as ABT
 import Unison.Auth.Types qualified as Auth
 import Unison.Builtin.Decls qualified as DD
+import Unison.Cli.MergeTypes (MergeSourceAndTarget (..))
 import Unison.Cli.Pretty
 import Unison.Cli.ProjectUtils qualified as ProjectUtils
 import Unison.Cli.ServantClientUtils qualified as ServantClientUtils
@@ -72,9 +75,7 @@ import Unison.Codebase.Runtime qualified as Runtime
 import Unison.Codebase.ShortCausalHash (ShortCausalHash)
 import Unison.Codebase.ShortCausalHash qualified as SCH
 import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
-import Unison.Codebase.SqliteCodebase.GitError
-  ( GitSqliteCodebaseError (..),
-  )
+import Unison.Codebase.SqliteCodebase.GitError (GitSqliteCodebaseError (..))
 import Unison.Codebase.TermEdit qualified as TermEdit
 import Unison.Codebase.Type (GitError (GitCodebaseError, GitProtocolError, GitSqliteCodebaseError))
 import Unison.Codebase.TypeEdit qualified as TypeEdit
@@ -1605,31 +1606,41 @@ notifyUser dir = \case
   PullAlreadyUpToDate ns dest ->
     pure . P.callout "😶" $
       P.wrap $
-        prettyNamespaceKey dest
+        prettyProjectAndBranchName (ProjectAndBranch dest.project.name dest.branch.name)
           <> "was already up-to-date with"
           <> P.group (prettyReadRemoteNamespace ns <> ".")
   PullSuccessful ns dest ->
     pure . P.okCallout $
       P.wrap $
         "Successfully updated"
-          <> prettyNamespaceKey dest
+          <> prettyProjectAndBranchName (ProjectAndBranch dest.project.name dest.branch.name)
           <> "from"
           <> P.group (prettyReadRemoteNamespace ns <> ".")
   AboutToMerge -> pure "Merging..."
   MergeOverEmpty dest ->
     pure . P.okCallout $
       P.wrap $
-        "Successfully pulled into " <> P.group (prettyNamespaceKey dest <> ", which was empty.")
+        "Successfully pulled into "
+          <> P.group
+            ( prettyProjectAndBranchName (ProjectAndBranch dest.project.name dest.branch.name)
+                <> ", which was empty."
+            )
   MergeAlreadyUpToDate src dest ->
     pure . P.callout "😶" $
       P.wrap $
-        prettyNamespaceKey dest
+        either prettyPath' prettyProjectAndBranchName dest
           <> "was already up-to-date with"
-          <> P.group (prettyNamespaceKey src <> ".")
-  MergeConflictedAliases branch name1 name2 ->
+          <> P.group (either prettyPath' prettyProjectAndBranchName src <> ".")
+  MergeAlreadyUpToDate2 aliceAndBob ->
+    pure . P.callout "😶" $
+      P.wrap $
+        prettyProjectAndBranchName aliceAndBob.alice
+          <> "was already up-to-date with"
+          <> P.group (prettyMergeSource aliceAndBob.bob <> ".")
+  MergeConflictedAliases aliceOrBob name1 name2 ->
     pure . P.wrap $
       "On"
-        <> P.group (prettyProjectBranchName branch <> ",")
+        <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
         <> prettyName name1
         <> "and"
         <> prettyName name2
@@ -1645,35 +1656,49 @@ notifyUser dir = \case
       "There's a merge conflict on"
         <> P.group (prettyName name <> ",")
         <> "but it's a builtin on one or both branches. We can't yet handle merge conflicts on builtins."
-  MergeConstructorAlias maybeBranch name1 name2 ->
+  MergeConstructorAlias maybeAliceOrBob name1 name2 ->
     pure . P.wrap $
       "On"
-        <> case maybeBranch of
+        <> case maybeAliceOrBob of
           Nothing -> "the LCA,"
-          Just branch -> P.group (prettyProjectBranchName branch <> ",")
+          Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
         <> prettyName name1
         <> "and"
         <> prettyName name2
         <> "are aliases. Every type declaration must have exactly one name for each constructor."
-  MergeDefnsInLib ->
+  MergeDefnsInLib aliceOrBob ->
     pure . P.wrap $
-      "There's a type or term directly in the `lib` namespace, but I expected only library dependencies to be in there."
+      "On"
+        <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
+        <> "there's a type or term directly in the `lib` namespace, but I expected only library dependencies to be in there."
         <> "Please remove it before merging."
-  MergeMissingConstructorName name ->
+  MergeMissingConstructorName maybeAliceOrBob name ->
     pure . P.wrap $
-      "The type"
+      "On"
+        <> case maybeAliceOrBob of
+          Nothing -> "the LCA,"
+          Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
+        <> "the type"
         <> prettyName name
         <> "is missing a name for one of its constructors. Please add one before merging."
-  MergeNestedDeclAlias shorterName longerName ->
+  MergeNestedDeclAlias maybeAliceOrBob shorterName longerName ->
     pure . P.wrap $
-      "The type"
+      "On"
+        <> case maybeAliceOrBob of
+          Nothing -> "the LCA,"
+          Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
+        <> "the type"
         <> prettyName longerName
         <> "is an alias of"
         <> P.group (prettyName shorterName <> ".")
         <> "Type aliases cannot be nested. Please make them disjoint before merging."
-  MergeStrayConstructor name ->
+  MergeStrayConstructor maybeAliceOrBob name ->
     pure . P.wrap $
-      "The constructor"
+      "On"
+        <> case maybeAliceOrBob of
+          Nothing -> "the LCA,"
+          Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
+        <> "the constructor"
         <> prettyName name
         <> "is not in a subnamespace of a name of its type."
         <> "Please either delete it or rename it before merging."
@@ -2260,26 +2285,26 @@ notifyUser dir = \case
           "",
           "Your non-project code is still available to pull from Share, and you can pull it into a local namespace using `pull myhandle.public`"
         ]
-  MergeFailure path base target ->
+  MergeFailure path aliceAndBob ->
     pure . P.wrap $
       "I couldn't automatically merge"
-        <> prettyProjectBranchName (view #branch target)
+        <> prettyMergeSource aliceAndBob.bob
         <> "into"
-        <> P.group (prettyProjectBranchName (view #branch base) <> ".")
+        <> P.group (prettyProjectAndBranchName aliceAndBob.alice <> ".")
         <> "However, I've added the definitions that need attention to the top of"
         <> P.group (prettyFilePath path <> ".")
-  MergeSuccess base target ->
+  MergeSuccess aliceAndBob ->
     pure . P.wrap $
       "I merged"
-        <> prettyProjectBranchName (view #branch target)
+        <> prettyMergeSource aliceAndBob.bob
         <> "into"
-        <> P.group (prettyProjectBranchName (view #branch base) <> ".")
-  MergeSuccessFastForward base target ->
+        <> P.group (prettyProjectAndBranchName aliceAndBob.alice <> ".")
+  MergeSuccessFastForward aliceAndBob ->
     pure . P.wrap $
       "I fast-forward merged"
-        <> prettyProjectBranchName (view #branch target)
+        <> prettyMergeSource aliceAndBob.bob
         <> "into"
-        <> P.group (prettyProjectBranchName (view #branch base) <> ".")
+        <> P.group (prettyProjectAndBranchName aliceAndBob.alice <> ".")
   InstalledLibdep libdep segment ->
     pure . P.wrap $
       "I installed"

unison-cli/unison-cli.cabal

@@ -35,6 +35,7 @@ library
       Unison.Auth.Types
       Unison.Auth.UserInfo
       Unison.Cli.DownloadUtils
+      Unison.Cli.MergeTypes
       Unison.Cli.Monad
       Unison.Cli.MonadUtils
       Unison.Cli.NamesUtils

unison-core/src/Unison/Project.hs

@@ -17,6 +17,8 @@ module Unison.Project
     ProjectBranchSpecifier (..),
     ProjectAndBranch (..),
     projectAndBranchNamesParser,
+    projectAndOptionalBranchParser,
+    branchWithOptionalProjectParser,
     ProjectAndBranchNames (..),
     projectAndBranchNamesParser2,
     projectNameParser,

unison-merge/src/Unison/Merge/Database.hs

@@ -16,11 +16,12 @@ import U.Codebase.Sqlite.Operations qualified as Operations
 import Unison.Builtin qualified as Builtins
 import Unison.Codebase (Codebase)
 import Unison.Codebase qualified as Codebase
-import Unison.Codebase.Branch qualified as V1
+import Unison.Codebase.SqliteCodebase.Operations qualified as Operations (expectDeclComponent)
 import Unison.ConstructorReference (GConstructorReference (..))
 import Unison.ConstructorType (ConstructorType)
 import Unison.DataDeclaration qualified as V1 (Decl)
 import Unison.DataDeclaration qualified as V1.Decl
+import Unison.Hash (Hash)
 import Unison.Parser.Ann qualified as V1 (Ann)
 import Unison.Prelude
 import Unison.Referent qualified as V1 (Referent)
@@ -29,6 +30,7 @@ import Unison.Sqlite (Transaction)
 import Unison.Sqlite qualified as Sqlite
 import Unison.Symbol qualified as V1 (Symbol)
 import Unison.Term qualified as V1 (Term)
+import Unison.Type qualified as V1 (Type)
 import Unison.Util.Cache qualified as Cache
 
 ------------------------------------------------------------------------------------------------------------------------
@@ -39,9 +41,10 @@ data MergeDatabase = MergeDatabase
   { loadCausal :: CausalHash -> Transaction (CausalBranch Transaction),
     loadDeclNumConstructors :: TypeReferenceId -> Transaction Int,
     loadDeclType :: TypeReference -> Transaction ConstructorType,
-    loadV1Branch :: CausalHash -> Transaction (V1.Branch Transaction),
     loadV1Decl :: TypeReferenceId -> Transaction (V1.Decl V1.Symbol V1.Ann),
-    loadV1Term :: TermReferenceId -> Transaction (V1.Term V1.Symbol V1.Ann)
+    loadV1DeclComponent :: Hash -> Transaction [V1.Decl V1.Symbol V1.Ann],
+    loadV1Term :: TermReferenceId -> Transaction (V1.Term V1.Symbol V1.Ann),
+    loadV1TermComponent :: Hash -> Transaction [(V1.Term V1.Symbol V1.Ann, V1.Type V1.Symbol V1.Ann)]
   }
 
 makeMergeDatabase :: MonadIO m => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase
@@ -53,7 +56,6 @@ makeMergeDatabase codebase = liftIO do
   loadDeclNumConstructors <- do
     cache <- Cache.semispaceCache 1024
     pure (Sqlite.cacheTransaction cache Operations.expectDeclNumConstructors)
-  let loadV1Branch = undefined -- Codebase.expectBranchForHash codebase
   loadV1Decl <- do
     cache <- Cache.semispaceCache 1024
     pure (Sqlite.cacheTransaction cache (Codebase.unsafeGetTypeDeclaration codebase))
@@ -67,7 +69,18 @@ makeMergeDatabase codebase = liftIO do
   loadV1Term <- do
     cache <- Cache.semispaceCache 1024
     pure (Sqlite.cacheTransaction cache (Codebase.unsafeGetTerm codebase))
-  pure MergeDatabase {loadCausal, loadDeclNumConstructors, loadDeclType, loadV1Branch, loadV1Decl, loadV1Term}
+  let loadV1TermComponent = Codebase.unsafeGetTermComponent codebase
+  let loadV1DeclComponent = Operations.expectDeclComponent
+  pure
+    MergeDatabase
+      { loadCausal,
+        loadDeclNumConstructors,
+        loadDeclType,
+        loadV1Decl,
+        loadV1DeclComponent,
+        loadV1Term,
+        loadV1TermComponent
+      }
 
 -- Convert a v2 referent (missing decl type) to a v1 referent.
 referent2to1 :: MergeDatabase -> Referent -> Transaction V1.Referent

unison-merge/src/Unison/Merge/PreconditionViolation.hs

@@ -1,39 +0,0 @@
-module Unison.Merge.PreconditionViolation
-  ( PreconditionViolation (..),
-  )
-where
-
-import U.Codebase.Reference (TypeReference)
-import Unison.Core.Project (ProjectBranchName)
-import Unison.Name (Name)
-import Unison.Prelude
-import Unison.Referent (Referent)
-
--- | A reason that a merge could not be performed.
-data PreconditionViolation
-  = -- | @ConflictedAliases branch foo bar@: in project branch @branch@, @foo@ and @bar@ refer to different things,
-    -- but at one time (in the LCA of another branch, in fact) they referred to the same thing.
-    ConflictedAliases !ProjectBranchName !Name !Name
-  | -- | @ConflictedTermName name refs@: @name@ refers to 2+ referents @refs@.
-    ConflictedTermName !Name !(Set Referent)
-  | -- | @ConflictedTypeName name refs@: @name@ refers to 2+ type references @refs@.
-    ConflictedTypeName !Name !(Set TypeReference)
-  | -- | @ConflictInvolvingBuiltin name@: @name@ is involved in a conflict, but it refers to a builtin (on at least one
-    -- side). Since we can't put a builtin in a scratch file, we bomb in these cases.
-    ConflictInvolvingBuiltin !Name
-  | -- | A second naming of a constructor was discovered underneath a decl's name, e.g.
-    --
-    --   Foo#Foo
-    --   Foo.Bar#Foo#0
-    --   Foo.Some.Other.Name.For.Bar#Foo#0
-    --
-    -- If the project branch name is missing, it means the LCA is in violation.
-    ConstructorAlias !(Maybe ProjectBranchName) !Name !Name -- first name we found, second name we found
-  | -- | There were some definitions at the top level of lib.*, which we don't like
-    DefnsInLib
-  | -- | This type name is missing a name for one of its constructors.
-    MissingConstructorName !Name
-  | -- | This type name is a nested alias, e.g. "Foo.Bar.Baz" which is an alias of "Foo" or "Foo.Bar".
-    NestedDeclAlias !Name !Name -- shorter name, longer name
-  | StrayConstructor !Name
-  deriving stock (Show)

unison-merge/src/Unison/Merge/TwoOrThreeWay.hs

@@ -10,4 +10,4 @@ data TwoOrThreeWay a = TwoOrThreeWay
     alice :: a,
     bob :: a
   }
-  deriving stock (Functor, Generic)
+  deriving stock (Foldable, Functor, Generic, Traversable)

unison-merge/unison-merge.cabal

@@ -27,7 +27,6 @@ library
       Unison.Merge.EitherWayI
       Unison.Merge.Libdeps
       Unison.Merge.PartitionCombinedDiffs
-      Unison.Merge.PreconditionViolation
       Unison.Merge.Synhash
       Unison.Merge.Synhashed
       Unison.Merge.ThreeWay

unison-src/transcripts/merge.output.md

@@ -24,7 +24,7 @@ Merge result:
 ```ucm
 project/alice> merge /bob
 
-  I merged bob into alice.
+  I merged project/bob into project/alice.
 
 project/alice> view foo bar
 
@@ -58,7 +58,7 @@ Merge result:
 ```ucm
 project/alice> merge /bob
 
-  I merged bob into alice.
+  I merged project/bob into project/alice.
 
 project/alice> view foo bar
 
@@ -101,7 +101,7 @@ Merge result:
 ```ucm
 project/alice> merge /bob
 
-  I merged bob into alice.
+  I merged project/bob into project/alice.
 
 project/alice> view foo bar
 
@@ -164,7 +164,7 @@ Merge result:
 ```ucm
 project/alice> merge /bob
 
-  I merged bob into alice.
+  I merged project/bob into project/alice.
 
 project/alice> view foo bar baz
 
@@ -234,7 +234,7 @@ Merge result:
 ```ucm
 project/alice> merge /bob
 
-  I merged bob into alice.
+  I merged project/bob into project/alice.
 
 project/alice> view foo bar baz
 
@@ -283,7 +283,7 @@ Merge result:
 ```ucm
 project/alice> merge /bob
 
-  I merged bob into alice.
+  I merged project/bob into project/alice.
 
 project/alice> view foo
 
@@ -325,7 +325,7 @@ Merge result:
 ```ucm
 project/alice> merge bob
 
-  I merged bob into alice.
+  I merged project/bob into project/alice.
 
 project/alice> view foo bar baz
 
@@ -446,7 +446,7 @@ project/bob> add
 
 project/alice> merge /bob
 
-  I fast-forward merged bob into alice.
+  I fast-forward merged project/bob into project/alice.
 
 ```
 ## Merge failure: someone deleted something
@@ -485,15 +485,12 @@ project/bob> add
 
 project/alice> merge /bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
--- The definitions below are not conflicted, but they each depend on one or more
--- conflicted definitions above.
-
 bar : Text
 bar =
   use Text ++
@@ -529,15 +526,12 @@ bar = foo ++ " - " ++ foo
 ```ucm
 project/alice> merge /bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
--- The definitions below are not conflicted, but they each depend on one or more
--- conflicted definitions above.
-
 bar : Text
 bar =
   use Text ++
@@ -585,9 +579,9 @@ baz = "bobs baz"
 ```ucm
 project/alice> merge /bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
@@ -642,9 +636,9 @@ unique type Foo = MkFoo Nat Text
 ```ucm
 project/alice> merge /bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
@@ -679,9 +673,9 @@ unique type Foo = Baz Nat | BobQux Text
 ```ucm
 project/alice> merge /bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
@@ -720,9 +714,9 @@ project/bob> move.term Foo.Qux Foo.Bob
 ```ucm
 project/alice> merge bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
@@ -754,9 +748,9 @@ unique ability my.cool where
 ```ucm
 project/alice> merge bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
@@ -800,9 +794,9 @@ These won't cleanly merge.
 ```ucm
 project/alice> merge bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
@@ -862,9 +856,9 @@ Notably, Alice's "unconflicted" update on the name "Foo.Bar.Baz" (because she ch
 ```ucm
 project/alice> merge bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
@@ -909,9 +903,9 @@ bob _ = 19
 ```ucm
 project/alice> merge bob
 
-  I couldn't automatically merge bob into alice. However, I've
-  added the definitions that need attention to the top of
-  scratch.u.
+  I couldn't automatically merge project/bob into project/alice.
+  However, I've added the definitions that need attention to the
+  top of scratch.u.
 
 ```
 ```unison:added-by-ucm scratch.u
@@ -970,7 +964,8 @@ baz = "baz"
 ```ucm
 project/alice> merge /bob
 
-  On alice, bar and foo are not aliases, but they used to be.
+  On project/alice, bar and foo are not aliases, but they used
+  to be.
 
 ```
 ### Conflict involving builtin
@@ -1024,9 +1019,9 @@ bob = 100
 ```ucm
 project/alice> merge /bob
 
-  On alice, Foo.Bar and Foo.some.other.Alias are aliases. Every
-  type declaration must have exactly one name for each
-  constructor.
+  On project/alice, Foo.Bar and Foo.some.other.Alias are
+  aliases. Every type declaration must have exactly one name for
+  each constructor.
 
 ```
 ### Missing constructor name
@@ -1053,8 +1048,8 @@ bob = 100
 ```ucm
 project/alice> merge /bob
 
-  The type Foo is missing a name for one of its constructors.
-  Please add one before merging.
+  On project/alice, the type Foo is missing a name for one of
+  its constructors. Please add one before merging.
 
 ```
 ### Nested decl alias
@@ -1086,8 +1081,9 @@ bob = 100
 ```ucm
 project/alice> merge /bob
 
-  The type A.inner.X is an alias of A. Type aliases cannot be
-  nested. Please make them disjoint before merging.
+  On project/alice, the type A.inner.X is an alias of A. Type
+  aliases cannot be nested. Please make them disjoint before
+  merging.
 
 ```
 ### Stray constructor alias
@@ -1119,9 +1115,9 @@ project/bob> add
 ```ucm
 project/alice> merge bob
 
-  The constructor AliasOutsideFooNamespace is not in a
-  subnamespace of a name of its type. Please either delete it or
-  rename it before merging.
+  On project/alice, the constructor AliasOutsideFooNamespace is
+  not in a subnamespace of a name of its type. Please either
+  delete it or rename it before merging.
 
 ```
 ### Term or type in `lib`
@@ -1143,8 +1139,8 @@ bob = 100
 ```ucm
 project/alice> merge /bob
 
-  There's a type or term directly in the `lib` namespace, but I
-  expected only library dependencies to be in there. Please
-  remove it before merging.
+  On project/alice, there's a type or term directly in the `lib`
+  namespace, but I expected only library dependencies to be in
+  there. Please remove it before merging.
 
 ```