Merge remote-tracking branch 'upstream/trunk' into restrict-NameSegment

.editorconfig

@@ -0,0 +1,11 @@
+# Multi-editor style config: https://EditorConfig.org
+
+root = true
+
+[*]
+charset = utf-8
+end_of_line = lf
+indent_style = space
+insert_final_newline = true
+max_line_length = 120
+trim_trailing_whitespace = true

.github/workflows/ci.yaml

@@ -378,7 +378,7 @@ jobs:
           contents: |
             ```ucm
             .> project.create-empty jit-setup
-            jit-setup/main> pull ${{ env.jit_version }} lib.jit
+            jit-setup/main> lib.install ${{ env.jit_version }}
             ```
             ```unison
             go = generateSchemeBoot "${{ env.jit_generated_src_scheme }}"

.github/workflows/nix-dev-cache.yaml

@@ -23,12 +23,12 @@ jobs:
           - macOS-12
     steps:
     - uses: actions/checkout@v4
-    - uses: cachix/install-nix-action@v22
+    - uses: cachix/install-nix-action@v27
       with:
         extra_nix_config: |
           extra-trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=
           extra-substituters = https://cache.iog.io
-    - uses: cachix/cachix-action@v12
+    - uses: cachix/cachix-action@v15
       with:
         name: unison
         authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'

.gitignore

@@ -24,5 +24,7 @@ dist-newstyle
 
 # Mac developers
 **/.DS_Store
-
 /libb2.dylib
+
+# Nix
+result

.mergify.yml

@@ -11,9 +11,12 @@ pull_request_rules:
       - check-success=run interpreter tests (macOS-12)
       # - check-success=run interpreter tests (windows-2019)
       - check-success=generate jit source
-      - check-success=build jit binary (ubuntu-20.04)
-      - check-success=build jit binary (macOS-12)
-      - check-success=build jit binary (windows-2019)
+      - check-success=build jit binary / build jit binary (ubuntu-20.04)
+      - check-success=build jit binary / build jit binary (macOS-12)
+      - check-success=build jit binary / build jit binary (windows-2019)
+      - check-success=test jit / test jit (ubuntu-20.04)
+      - check-success=test jit / test jit (macOS-12)
+      # - check-success=test jit / test jit (windows-2019)
       - label=ready-to-merge
       - "#approved-reviews-by>=1"
     actions:

README.md

@@ -1,7 +1,8 @@
 The Unison language
 ===================
 
-[![Build Status](https://github.com/unisonweb/unison/actions/workflows/ci.yaml/badge.svg)](https://github.com/unisonweb/unison/actions/workflows/ci.yaml?query=branch%3Atrunk)
+[![CI Status](https://github.com/unisonweb/unison/actions/workflows/ci.yaml/badge.svg)](https://github.com/unisonweb/unison/actions/workflows/ci.yaml?query=branch%3Atrunk)
+[![Pre-Release Status](https://github.com/unisonweb/unison/actions/workflows/pre-release.yaml/badge.svg)](https://github.com/unisonweb/unison/actions/workflows/pre-release.yaml)
 
 * [Overview](#overview)
 * [Building using Stack](#building-using-stack)

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

development.markdown

@@ -126,9 +126,9 @@ This is specified with the normal
 
 Some examples:
 ```
-nix build '.#haskell-nix.unison-cli:lib:unison-cli'
-nix build '.#haskell-nix.unison-syntax:test:syntax-tests'
-nix build '.#haskell-nix.unison-cli:exe:transcripts'
+nix build '.#component-unison-cli:lib:unison-cli'
+nix build '.#component-unison-syntax:test:syntax-tests'
+nix build '.#component-unison-cli:exe:transcripts'
 ```
 
 ### Development environments
@@ -154,7 +154,7 @@ all non-local haskell dependencies (including profiling dependencies)
 are provided in the nix shell.
 
 ```
-nix develop '.#haskell-nix.local'
+nix develop '.#cabal-local'
 ```
 
 #### Get into a development environment for building a specific package
@@ -164,17 +164,17 @@ all haskell dependencies of this package are provided by the nix shell
 (including profiling dependencies).
 
 ```
-nix develop '.#haskell-nix.<package-name>'
+nix develop '.#cabal-<package-name>'
 ```
 
 for example:
 
 ```
-nix develop '.#haskell-nix.unison-cli'
+nix develop '.#cabal-unison-cli'
 ```
 or
 ```
-nix develop '.#haskell-nix.unison-parser-typechecker'
+nix develop '.#cabal-unison-parser-typechecker'
 ```
 
 This is useful if you wanted to profile a package. For example, if you
@@ -183,7 +183,7 @@ shells, cd into its directory, then run the program with
 profiling.
 
 ```
-nix develop '.#unison-parser-typechecker'
+nix develop '.#cabal-unison-parser-typechecker'
 cd unison-cli
 cabal run --enable-profiling unison-cli-main:exe:unison -- +RTS -p
 ```

flake.nix

@@ -88,42 +88,50 @@
               '';
             };
           };
+
+          renameAttrs = fn: nixpkgs.lib.mapAttrs' (name: value: {
+            inherit value;
+            name = fn name;});
         in
         assert nixpkgs-packages.ormolu.version == versions.ormolu;
         assert nixpkgs-packages.hls.version == versions.hls;
         assert nixpkgs-packages.unwrapped-stack.version == versions.stack;
         assert nixpkgs-packages.hpack.version == versions.hpack;
         {
-          packages = nixpkgs-packages // {
-            default = haskell-nix-flake.defaultPackage;
-            haskell-nix = haskell-nix-flake.packages;
-            docker = import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; };
-            build-tools = pkgs.symlinkJoin {
-              name = "build-tools";
-              paths = self.devShells."${system}".only-tools-nixpkgs.buildInputs;
-            };
-            all = pkgs.symlinkJoin {
-              name = "all";
-              paths =
-                let
-                  all-other-packages = builtins.attrValues (builtins.removeAttrs self.packages."${system}" [ "all" "build-tools" ]);
-                  devshell-inputs = builtins.concatMap
-                    (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs)
-                    [
-                      self.devShells."${system}".only-tools-nixpkgs
-                    ];
-                in
-                all-other-packages ++ devshell-inputs;
+          packages =
+            nixpkgs-packages
+            // renameAttrs (name: "component-${name}") haskell-nix-flake.packages
+            // renameAttrs (name: "docker-${name}") (import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; })
+            // {
+              default = haskell-nix-flake.defaultPackage;
+              build-tools = pkgs.symlinkJoin {
+                name = "build-tools";
+                paths = self.devShells."${system}".only-tools-nixpkgs.buildInputs;
+              };
+              all = pkgs.symlinkJoin {
+                name = "all";
+                paths =
+                  let
+                    all-other-packages = builtins.attrValues (builtins.removeAttrs self.packages."${system}" [ "all" "build-tools" ]);
+                    devshell-inputs = builtins.concatMap
+                      (devShell: devShell.buildInputs ++ devShell.nativeBuildInputs)
+                      [
+                        self.devShells."${system}".only-tools-nixpkgs
+                      ];
+                  in
+                  all-other-packages ++ devshell-inputs;
+              };
             };
+
+          apps = renameAttrs (name: "component-${name}") haskell-nix-flake.apps // {
+            default = self.apps."${system}"."component-unison-cli-main:exe:unison";
           };
 
-          apps = haskell-nix-flake.apps // {
-            default = self.apps."${system}"."unison-cli-main:exe:unison";
-          };
-
-          devShells = nixpkgs-devShells // {
-            default = self.devShells."${system}".only-tools-nixpkgs;
-            haskell-nix = haskell-nix-flake.devShells;
-          };
+          devShells =
+            nixpkgs-devShells
+            // renameAttrs (name: "cabal-${name}") haskell-nix-flake.devShells
+            // {
+              default = self.devShells."${system}".only-tools-nixpkgs;
+            };
         });
 }

lib/unison-prelude/package.yaml

@@ -12,6 +12,7 @@ dependencies:
   - base
   - bytestring
   - containers
+  - directory
   - generic-lens
   - either
   - extra

lib/unison-prelude/src/Unison/Debug.hs

@@ -25,7 +25,6 @@ import UnliftIO.Environment (lookupEnv)
 data DebugFlag
   = Auth
   | Codebase
-  | Git
   | Integrity
   | Merge
   | Migration
@@ -59,7 +58,6 @@ debugFlags = case (unsafePerformIO (lookupEnv "UNISON_DEBUG")) of
     case Text.toUpper . Text.strip $ w of
       "AUTH" -> pure Auth
       "CODEBASE" -> pure Codebase
-      "GIT" -> pure Git
       "INTEGRITY" -> pure Integrity
       "MERGE" -> pure Merge
       "MIGRATION" -> pure Migration
@@ -77,10 +75,6 @@ debugFlags = case (unsafePerformIO (lookupEnv "UNISON_DEBUG")) of
       _ -> empty
 {-# NOINLINE debugFlags #-}
 
-debugGit :: Bool
-debugGit = Git `Set.member` debugFlags
-{-# NOINLINE debugGit #-}
-
 debugSqlite :: Bool
 debugSqlite = Sqlite `Set.member` debugFlags
 {-# NOINLINE debugSqlite #-}
@@ -146,11 +140,11 @@ debugPatternCoverageConstraintSolver = PatternCoverageConstraintSolver `Set.memb
 {-# NOINLINE debugPatternCoverageConstraintSolver #-}
 
 -- | Use for trace-style selective debugging.
--- E.g. 1 + (debug Git "The second number" 2)
+-- E.g. 1 + (debug Sync "The second number" 2)
 --
 -- Or, use in pattern matching to view arguments.
 -- E.g.
--- myFunc (debug Git "argA" -> argA) = ...
+-- myFunc (debug Sync "argA" -> argA) = ...
 debug :: (Show a) => DebugFlag -> String -> a -> a
 debug flag msg a =
   if shouldDebug flag
@@ -160,7 +154,7 @@ debug flag msg a =
 -- | Use for selective debug logging in monadic contexts.
 -- E.g.
 -- do
---   debugM Git "source repo" srcRepo
+--   debugM Sync "source repo" srcRepo
 --   ...
 debugM :: (Show a, Monad m) => DebugFlag -> String -> a -> m ()
 debugM flag msg a =
@@ -187,7 +181,6 @@ shouldDebug :: DebugFlag -> Bool
 shouldDebug = \case
   Auth -> debugAuth
   Codebase -> debugCodebase
-  Git -> debugGit
   Integrity -> debugIntegrity
   Merge -> debugMerge
   Migration -> debugMigration

lib/unison-prelude/src/Unison/Prelude.hs

@@ -82,6 +82,7 @@ import GHC.Generics as X (Generic, Generic1)
 import GHC.IO.Handle qualified as Handle
 import GHC.Stack as X (HasCallStack)
 import Safe as X (atMay, headMay, lastMay, readMay)
+import System.Directory qualified as Directory
 import System.FilePath qualified as FilePath
 import System.IO qualified as IO
 import Text.Read as X (readMaybe)
@@ -236,23 +237,28 @@ writeUtf8 fileName txt = do
     Handle.hSetEncoding handle IO.utf8
     Text.hPutStr handle txt
 
--- | Atomically prepend some text to a file
+-- | Atomically prepend some text to a file, creating the file if it doesn't already exist
 prependUtf8 :: FilePath -> Text -> IO ()
 prependUtf8 path txt = do
-  let withTempFile tmpFilePath tmpHandle = do
-        Text.hPutStrLn tmpHandle txt
-        IO.withFile path IO.ReadMode \currentScratchFile -> do
-          let copyLoop = do
-                chunk <- Text.hGetChunk currentScratchFile
-                case Text.length chunk == 0 of
-                  True -> pure ()
-                  False -> do
-                    Text.hPutStr tmpHandle chunk
-                    copyLoop
-          copyLoop
-        IO.hClose tmpHandle
-        UnliftIO.renameFile tmpFilePath path
-  UnliftIO.withTempFile (FilePath.takeDirectory path) ".unison-scratch" withTempFile
+  Directory.doesFileExist path >>= \case
+    False -> writeUtf8 path txt
+    True -> do
+      let withTempFile tmpFilePath tmpHandle = do
+            Handle.hSetEncoding tmpHandle IO.utf8
+            Text.hPutStrLn tmpHandle txt
+            IO.withFile path IO.ReadMode \currentScratchFile -> do
+              Handle.hSetEncoding currentScratchFile IO.utf8
+              let copyLoop = do
+                    chunk <- Text.hGetChunk currentScratchFile
+                    case Text.length chunk == 0 of
+                      True -> pure ()
+                      False -> do
+                        Text.hPutStr tmpHandle chunk
+                        copyLoop
+              copyLoop
+            IO.hClose tmpHandle
+            UnliftIO.renameFile tmpFilePath path
+      UnliftIO.withTempFile (FilePath.takeDirectory path) ".unison-scratch" withTempFile
 
 reportBug :: String -> String -> String
 reportBug bugId msg =

lib/unison-prelude/src/Unison/Util/Map.hs

@@ -5,6 +5,7 @@ module Unison.Util.Map
     bitraverse,
     bitraversed,
     deleteLookup,
+    deleteLookupJust,
     elemsSet,
     foldM,
     foldMapM,
@@ -21,6 +22,7 @@ module Unison.Util.Map
     upsertF,
     upsertLookup,
     valuesVector,
+    asList_,
   )
 where
 
@@ -56,6 +58,15 @@ bitraversed :: (Ord a', Ord k') => Traversal k k' a a' -> Traversal v v' a a' ->
 bitraversed keyT valT f m =
   bitraverse (keyT f) (valT f) m
 
+-- | Traverse a map as a list of key-value pairs.
+-- Note: This can have unexpected results if the result contains duplicate keys.
+asList_ :: Ord k' => Traversal (Map k v) (Map k' v') [(k, v)] [(k', v')]
+asList_ f s =
+  s
+    & Map.toList
+    & f
+    <&> Map.fromList
+
 -- | 'swap' throws away data if the input contains duplicate values
 swap :: (Ord b) => Map a b -> Map b a
 swap =
@@ -96,6 +107,11 @@ deleteLookup :: (Ord k) => k -> Map k v -> (Maybe v, Map k v)
 deleteLookup =
   Map.alterF (,Nothing)
 
+-- | Like 'deleteLookup', but asserts the value is in the map prior to deletion.
+deleteLookupJust :: (HasCallStack, Ord k) => k -> Map k v -> (v, Map k v)
+deleteLookupJust =
+  Map.alterF (maybe (error (reportBug "E525283" "deleteLookupJust: element not found")) (,Nothing))
+
 -- | Like 'Map.elems', but return the values as a set.
 elemsSet :: Ord v => Map k v -> Set v
 elemsSet =

lib/unison-prelude/unison-prelude.cabal

@@ -65,6 +65,7 @@ library
       base
     , bytestring
     , containers
+    , directory
     , either
     , extra
     , filepath

nix/docker.nix

@@ -5,6 +5,6 @@
     name = "ucm";
     tag = "latest";
     contents = with pkgs; [ cacert fzf ];
-    config.Cmd = [ "${haskell-nix."unison-cli:exe:unison"}/bin/unison" ];
+    config.Cmd = [ "${haskell-nix."unison-cli-main:exe:unison"}/bin/unison" ];
   };
 }

parser-typechecker/src/Unison/Codebase.hs

@@ -86,10 +86,6 @@ module Unison.Codebase
     syncFromDirectory,
     syncToDirectory,
 
-    -- ** Remote sync
-    viewRemoteBranch,
-    pushGitBranch,
-
     -- * Codebase path
     getCodebaseDir,
     CodebasePath,
@@ -124,13 +120,11 @@ import Unison.Codebase.Branch (Branch)
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.BuiltinAnnotation (BuiltinAnnotation (builtinAnnotation))
 import Unison.Codebase.CodeLookup qualified as CL
-import Unison.Codebase.Editor.Git qualified as Git
-import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace)
 import Unison.Codebase.Path
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
 import Unison.Codebase.SqliteCodebase.Operations qualified as SqliteCodebase.Operations
-import Unison.Codebase.Type (Codebase (..), GitError)
+import Unison.Codebase.Type (Codebase (..))
 import Unison.CodebasePath (CodebasePath, getCodebaseDir)
 import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
 import Unison.DataDeclaration (Decl)
@@ -466,20 +460,6 @@ isType c r = case r of
   Reference.Builtin {} -> pure $ Builtin.isBuiltinType r
   Reference.DerivedId r -> isJust <$> getTypeDeclaration c r
 
--- * Git stuff
-
--- | Pull a git branch and view it from the cache, without syncing into the
--- local codebase.
-viewRemoteBranch ::
-  (MonadIO m) =>
-  Codebase m v a ->
-  ReadGitRemoteNamespace ->
-  Git.GitBranchBehavior ->
-  (Branch m -> m r) ->
-  m (Either GitError r)
-viewRemoteBranch codebase ns gitBranchBehavior action =
-  viewRemoteBranch' codebase ns gitBranchBehavior (\(b, _dir) -> action b)
-
 unsafeGetComponentLength :: (HasCallStack) => Hash -> Sqlite.Transaction Reference.CycleSize
 unsafeGetComponentLength h =
   Operations.getCycleLen h >>= \case

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/BranchUtil.hs

@@ -15,8 +15,6 @@ module Unison.Codebase.BranchUtil
     makeAddTermName,
     makeDeleteTermName,
     makeAnnihilateTermName,
-    makeDeletePatch,
-    makeReplacePatch,
   )
 where
 
@@ -24,7 +22,6 @@ import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Unison.Codebase.Branch (Branch, Branch0)
 import Unison.Codebase.Branch qualified as Branch
-import Unison.Codebase.Patch (Patch)
 import Unison.Codebase.Path (Path)
 import Unison.Codebase.Path qualified as Path
 import Unison.HashQualified' (HashQualified (HashQualified, NameOnly))
@@ -83,12 +80,6 @@ makeAnnihilateTermName (p, name) = (p, Branch.annihilateTermName name)
 makeAnnihilateTypeName :: Path.Split -> (Path, Branch0 m -> Branch0 m)
 makeAnnihilateTypeName (p, name) = (p, Branch.annihilateTypeName name)
 
-makeReplacePatch :: (Applicative m) => Path.Split -> Patch -> (Path, Branch0 m -> Branch0 m)
-makeReplacePatch (p, name) patch = (p, Branch.replacePatch name patch)
-
-makeDeletePatch :: Path.Split -> (Path, Branch0 m -> Branch0 m)
-makeDeletePatch (p, name) = (p, Branch.deletePatch name)
-
 makeAddTypeName :: Path.Split -> Reference -> (Path, Branch0 m -> Branch0 m)
 makeAddTypeName (p, name) r = (p, Branch.addTypeName r name)
 

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

@@ -4,8 +4,19 @@ module Unison.Codebase.Editor.DisplayObject where
 
 import Data.Bifoldable
 import Data.Bitraversable
+import Data.Set qualified as Set
+import U.Codebase.Reference (TermReference, TypeReference)
+import Unison.DataDeclaration qualified as DD
+import Unison.DataDeclaration.Dependencies qualified as DD
+import Unison.LabeledDependency qualified as LD
+import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.ShortHash (ShortHash)
+import Unison.Symbol (Symbol)
+import Unison.Term (Term)
+import Unison.Term qualified as Term
+import Unison.Type (Type)
+import Unison.Type qualified as Type
 
 data DisplayObject b a = BuiltinObject b | MissingObject ShortHash | UserObject a
   deriving (Eq, Ord, Show, Functor, Generic, Foldable, Traversable)
@@ -27,3 +38,14 @@ toMaybe :: DisplayObject b a -> Maybe a
 toMaybe = \case
   UserObject a -> Just a
   _ -> Nothing
+
+termDisplayObjectLabeledDependencies :: TermReference -> DisplayObject (Type Symbol Ann) (Term Symbol Ann) -> (Set LD.LabeledDependency)
+termDisplayObjectLabeledDependencies termRef displayObject = do
+  displayObject
+    & bifoldMap (Type.labeledDependencies) (Term.labeledDependencies)
+    & Set.insert (LD.TermReference termRef)
+
+typeDisplayObjectLabeledDependencies :: TypeReference -> DisplayObject () (DD.Decl Symbol Ann) -> Set LD.LabeledDependency
+typeDisplayObjectLabeledDependencies typeRef displayObject = do
+  displayObject
+    & foldMap (DD.labeledDeclDependenciesIncludingSelfAndFieldAccessors typeRef)

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

@@ -1,317 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Unison.Codebase.Editor.Git
-  ( gitIn,
-    gitTextIn,
-    gitInCaptured,
-    withRepo,
-    withIOError,
-    withStatus,
-    withIsolatedRepo,
-    debugGit,
-    gitDirToPath,
-    gitVerbosity,
-    GitBranchBehavior (..),
-    GitRepo (..),
-
-    -- * Exported for testing
-    gitCacheDir,
-  )
-where
-
-import Control.Exception qualified
-import Control.Monad.Except (MonadError, throwError)
-import Data.ByteString.Base16 qualified as ByteString
-import Data.Char qualified as Char
-import Data.Text qualified as Text
-import Shellmet (($?), ($^), ($|))
-import System.Exit (ExitCode (ExitSuccess))
-import System.FilePath ((</>))
-import Unison.Codebase.Editor.RemoteRepo (ReadGitRepo (..))
-import Unison.Codebase.GitError (GitProtocolError)
-import Unison.Codebase.GitError qualified as GitError
-import Unison.Debug qualified as Debug
-import Unison.Prelude
-import UnliftIO qualified
-import UnliftIO.Directory (XdgDirectory (XdgCache), doesDirectoryExist, findExecutable, getXdgDirectory)
-import UnliftIO.IO (hFlush, stdout)
-import UnliftIO.Process qualified as UnliftIO
-
-debugGit :: Bool
-debugGit = Debug.shouldDebug Debug.Git
-
-gitVerbosity :: [Text]
-gitVerbosity =
-  if debugGit
-    then []
-    else ["--quiet"]
-
--- https://superuser.com/questions/358855/what-characters-are-safe-in-cross-platform-file-names-for-linux-windows-and-os
-encodeFileName :: String -> FilePath
-encodeFileName s =
-  let go ('.' : rem) = "$dot$" <> go rem
-      go ('$' : rem) = "$$" <> go rem
-      go (c : rem)
-        | elem @[] c "/\\:*?\"<>|" || not (Char.isPrint c && Char.isAscii c) =
-            "$x" <> encodeHex [c] <> "$" <> go rem
-        | otherwise = c : go rem
-      go [] = []
-      encodeHex :: String -> String
-      encodeHex =
-        Text.unpack
-          . Text.toUpper
-          . ByteString.encodeBase16
-          . encodeUtf8
-          . Text.pack
-   in -- 'bare' suffix is to avoid clashes with non-bare repos initialized by earlier versions
-      -- of ucm.
-      go s <> "-bare"
-
-gitCacheDir :: (MonadIO m) => Text -> m FilePath
-gitCacheDir url =
-  getXdgDirectory XdgCache $
-    "unisonlanguage"
-      </> "gitfiles"
-      </> encodeFileName (Text.unpack url)
-
-withStatus :: (MonadIO m) => String -> m a -> m a
-withStatus str ma = do
-  flushStr str
-  a <- ma
-  flushStr (const ' ' <$> str)
-  pure a
-  where
-    flushStr str = do
-      liftIO . putStr $ "  " ++ str ++ "\r"
-      hFlush stdout
-
--- | Run an action on an isolated copy of the provided repo.
--- The repo is deleted when the action exits or fails.
--- A branch or tag to check out from the source repo may be specified.
-withIsolatedRepo ::
-  forall m r.
-  (MonadUnliftIO m) =>
-  GitRepo ->
-  Text ->
-  Maybe Text ->
-  (GitRepo -> m r) ->
-  m (Either GitProtocolError r)
-withIsolatedRepo srcPath origin mayGitRef action = do
-  UnliftIO.withSystemTempDirectory "ucm-isolated-repo" $ \tempDir -> do
-    let tempRepo = Worktree tempDir
-    copyCommand tempRepo >>= \case
-      Left gitErr -> pure $ Left (GitError.CopyException (gitDirToPath srcPath) tempDir (show gitErr))
-      Right () -> Right <$> action tempRepo
-  where
-    copyCommand :: GitRepo -> m (Either IOException ())
-    copyCommand dest = UnliftIO.tryIO . liftIO $ do
-      gitGlobal
-        ( ["clone", "--origin", "git-cache"]
-            -- tags work okay here too.
-            ++ maybe [] (\t -> ["--branch", t]) mayGitRef
-            ++ [Text.pack . gitDirToPath $ srcPath, Text.pack . gitDirToPath $ dest]
-        )
-      -- If a specific ref wasn't requested, ensure we have all branches and tags from the source.
-      -- This is fast since it's a local fetch.
-      when (isNothing mayGitRef) $ do
-        -- If the source repo is empty, we can't fetch, but there won't be anything to
-        -- fetch anyways.
-        unlessM (isEmptyGitRepo srcPath) $ do
-          gitIn dest $ ["fetch", "--tags", Text.pack . gitDirToPath $ srcPath] ++ gitVerbosity
-      gitIn dest $ ["remote", "add", "origin", origin]
-
--- | Define what to do if the repo we're pulling/pushing doesn't have the specified branch.
-data GitBranchBehavior
-  = -- If the desired branch doesn't exist in the repo,
-    -- create a new branch by the provided name with a fresh codebase
-    CreateBranchIfMissing
-  | -- Fail with an error if the branch doesn't exist.
-    RequireExistingBranch
-
--- | Clone or fetch an updated copy of the provided repository and check out the expected ref,
--- then provide the action with a path to the codebase in that repository.
--- Note that the repository provided to the action is temporary, it will be removed when the
--- action completes or fails.
-withRepo ::
-  forall m a.
-  (MonadUnliftIO m) =>
-  ReadGitRepo ->
-  GitBranchBehavior ->
-  (GitRepo -> m a) ->
-  m (Either GitProtocolError a)
-withRepo repo@(ReadGitRepo {url = uri, ref = mayGitRef}) branchBehavior action = UnliftIO.try $ do
-  throwExceptT $ checkForGit
-  gitCachePath <- gitCacheDir uri
-  -- Ensure we have the main branch in the cache dir no matter what
-  throwExceptT $ cloneIfMissing repo {ref = Nothing} gitCachePath
-  let gitCacheRepo = Bare gitCachePath
-  gitRef <- case mayGitRef of
-    Nothing -> fromMaybe "main" <$> getDefaultBranch gitCacheRepo
-    Just gitRef -> pure gitRef
-  doesRemoteRefExist <- fetchAndUpdateRef gitCacheRepo gitRef
-  if doesRemoteRefExist
-    then do
-      -- A ref by the requested name exists on the remote.
-      withStatus ("Checking out " ++ Text.unpack gitRef ++ " ...") $ do
-        -- Check out the ref in a new isolated repo
-        throwEitherM . withIsolatedRepo gitCacheRepo uri (Just gitRef) $ action
-    else do
-      -- No ref by the given name exists on the remote
-      case branchBehavior of
-        RequireExistingBranch -> UnliftIO.throwIO (GitError.RemoteRefNotFound uri gitRef)
-        CreateBranchIfMissing ->
-          withStatus ("Creating new branch " ++ Text.unpack gitRef ++ " ...")
-            . throwEitherM
-            . withIsolatedRepo gitCacheRepo uri Nothing
-            $ \(workTree) -> do
-              -- It's possible for the branch to exist in the cache even if it's not in the
-              -- remote, if for instance the branch was deleted from the remote.
-              -- In that case we delete the branch from the cache and create a new one.
-              localRefExists <- doesLocalRefExist gitCacheRepo gitRef
-              when localRefExists $ do
-                currentBranch <- gitTextIn workTree ["branch", "--show-current"]
-                -- In the rare case where we've got the branch already checked out,
-                -- we need to temporarily switch to a different branch so we can delete and
-                -- reset the branch to an orphan.
-                when (currentBranch == gitRef) $ gitIn workTree $ ["branch", "-B", "_unison_temp_branch"] ++ gitVerbosity
-                gitIn workTree $ ["branch", "-D", gitRef] ++ gitVerbosity
-              gitIn workTree $ ["checkout", "--orphan", gitRef] ++ gitVerbosity
-              -- Checking out an orphan branch doesn't actually clear the worktree, do that manually.
-              _ <- gitInCaptured workTree $ ["rm", "--ignore-unmatch", "-rf", "."] ++ gitVerbosity
-              action workTree
-  where
-    -- Check if a ref exists in the repository at workDir.
-    doesLocalRefExist :: GitRepo -> Text -> m Bool
-    doesLocalRefExist workDir ref = liftIO $ do
-      (gitIn workDir (["show-ref", "--verify", ref] ++ gitVerbosity) $> True)
-        $? pure False
-    -- fetch the given ref and update the local repositories ref to match the remote.
-    -- returns whether or not the ref existed on the remote.
-    fetchAndUpdateRef :: GitRepo -> Text -> m Bool
-    fetchAndUpdateRef workDir gitRef = do
-      (succeeded, _, _) <-
-        gitInCaptured
-          workDir
-          ( [ "fetch",
-              "--tags", -- if the gitref is a tag, fetch and update that too.
-              "--force", -- force updating local refs even if not fast-forward
-              -- update local refs with the same name they have on the remote.
-              "--refmap",
-              "*:*",
-              "--depth",
-              "1",
-              uri, -- The repo to fetch from
-              gitRef -- The specific reference to fetch
-            ]
-              ++ gitVerbosity
-          )
-      pure succeeded
-
--- | Do a `git clone` (for a not-previously-cached repo).
-cloneIfMissing :: (MonadIO m, MonadError GitProtocolError m) => ReadGitRepo -> FilePath -> m GitRepo
-cloneIfMissing repo@(ReadGitRepo {url = uri}) localPath = do
-  doesDirectoryExist localPath >>= \case
-    True ->
-      whenM (not <$> isGitRepo (Bare localPath)) $ do
-        throwError (GitError.UnrecognizableCacheDir repo localPath)
-    False -> do
-      -- directory doesn't exist, so clone anew
-      cloneRepo
-  pure $ Bare localPath
-  where
-    cloneRepo = do
-      withStatus ("Downloading from " ++ Text.unpack uri ++ " ...") $
-        ( liftIO $
-            gitGlobal
-              ( ["clone"]
-                  ++ ["--bare"]
-                  ++ ["--depth", "1"]
-                  ++ [uri, Text.pack localPath]
-              )
-        )
-          `withIOError` (throwError . GitError.CloneException repo . show)
-      isGitDir <- liftIO $ isGitRepo (Bare localPath)
-      unless isGitDir . throwError $ GitError.UnrecognizableCheckoutDir repo localPath
-
--- | See if `git` is on the system path.
-checkForGit :: (MonadIO m) => (MonadError GitProtocolError m) => m ()
-checkForGit = do
-  gitPath <- liftIO $ findExecutable "git"
-  when (isNothing gitPath) $ throwError GitError.NoGit
-
--- | Returns the name of the default branch of a repository, if one exists.
-getDefaultBranch :: (MonadIO m) => GitRepo -> m (Maybe Text)
-getDefaultBranch dir = liftIO $ do
-  (Text.stripPrefix "refs/heads/" <$> gitTextIn dir ["symbolic-ref", "HEAD"])
-    $? pure Nothing
-
--- | Does `git` recognize this directory as being managed by git?
-isGitRepo :: (MonadIO m) => GitRepo -> m Bool
-isGitRepo dir =
-  liftIO $
-    (True <$ gitIn dir (["rev-parse"] ++ gitVerbosity)) $? pure False
-
--- | Returns True if the repo is empty, i.e. has no commits at the current branch,
--- or if the dir isn't a git repo at all.
-isEmptyGitRepo :: (MonadIO m) => GitRepo -> m Bool
-isEmptyGitRepo dir = liftIO do
-  (gitTextIn dir (["rev-parse", "HEAD"] ++ gitVerbosity) $> False) $? pure True
-
--- | Perform an IO action, passing any IO exception to `handler`
-withIOError :: (MonadIO m) => IO a -> (IOException -> m a) -> m a
-withIOError action handler =
-  liftIO (fmap Right action `Control.Exception.catch` (pure . Left))
-    >>= either handler pure
-
--- | A path to a git repository.
-data GitRepo
-  = Bare FilePath
-  | Worktree FilePath
-  deriving (Show)
-
-gitDirToPath :: GitRepo -> FilePath
-gitDirToPath = \case
-  Bare fp -> fp
-  Worktree fp -> fp
-
--- | Generate some `git` flags for operating on some arbitary checked out copy
-setupGitDir :: GitRepo -> [Text]
-setupGitDir dir =
-  case dir of
-    Bare localPath ->
-      ["--git-dir", Text.pack localPath]
-    Worktree localPath ->
-      [ "--git-dir",
-        Text.pack (localPath </> ".git"),
-        "--work-tree",
-        Text.pack localPath
-      ]
-
--- | Run a git command in the current work directory.
--- Note: this should only be used for commands like 'clone' which don't interact with an
--- existing repository.
-gitGlobal :: (MonadIO m) => [Text] -> m ()
-gitGlobal args = do
-  when debugGit $ traceM (Text.unpack . Text.unwords $ ["$ git"] <> args)
-  liftIO $ "git" $^ (args ++ gitVerbosity)
-
--- | Run a git command in the repository at localPath
-gitIn :: (MonadIO m) => GitRepo -> [Text] -> m ()
-gitIn localPath args = do
-  when debugGit $ traceM (Text.unpack . Text.unwords $ ["$ git"] <> setupGitDir localPath <> args)
-  liftIO $ "git" $^ (setupGitDir localPath <> args)
-
--- | like 'gitIn', but silences all output from the command and returns whether the command
--- succeeded.
-gitInCaptured :: (MonadIO m) => GitRepo -> [Text] -> m (Bool, Text, Text)
-gitInCaptured localPath args = do
-  when debugGit $ traceM (Text.unpack . Text.unwords $ ["$ git"] <> setupGitDir localPath <> args)
-  (exitCode, stdout, stderr) <- UnliftIO.readProcessWithExitCode "git" (Text.unpack <$> setupGitDir localPath <> args) ""
-  pure (exitCode == ExitSuccess, Text.pack stdout, Text.pack stderr)
-
--- | Run a git command in the repository at localPath and capture stdout
-gitTextIn :: (MonadIO m) => GitRepo -> [Text] -> m Text
-gitTextIn localPath args = do
-  when debugGit $ traceM (Text.unpack . Text.unwords $ ["$ git"] <> setupGitDir localPath <> args)
-  liftIO $ "git" $| setupGitDir localPath <> args

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

@@ -2,22 +2,13 @@ module Unison.Codebase.Editor.RemoteRepo where
 
 import Control.Lens (Lens')
 import Control.Lens qualified as Lens
-import Data.Text qualified as Text
 import Data.Void (absurd)
 import Unison.Codebase.Path (Path)
 import Unison.Codebase.Path qualified as Path
-import Unison.Codebase.ShortCausalHash (ShortCausalHash)
-import Unison.Codebase.ShortCausalHash qualified as SCH
 import Unison.NameSegment qualified as NameSegment
 import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
 import Unison.Share.Types
-import Unison.Util.Monoid qualified as Monoid
-
-data ReadRepo
-  = ReadRepoGit ReadGitRepo
-  | ReadRepoShare ShareCodeserver
-  deriving stock (Eq, Ord, Show)
 
 data ShareCodeserver
   = DefaultCodeserver
@@ -44,58 +35,21 @@ displayShareCodeserver cs shareUser path =
         CustomCodeserver cu -> "share(" <> tShow cu <> ")."
    in shareServer <> shareUserHandleToText shareUser <> maybePrintPath path
 
-data ReadGitRepo = ReadGitRepo {url :: Text, ref :: Maybe Text}
-  deriving stock (Eq, Ord, Show)
-
-data WriteRepo
-  = WriteRepoGit WriteGitRepo
-  | WriteRepoShare ShareCodeserver
-  deriving stock (Eq, Ord, Show)
-
-data WriteGitRepo = WriteGitRepo {url :: Text, branch :: Maybe Text}
-  deriving stock (Eq, Ord, Show)
-
-writeToRead :: WriteRepo -> ReadRepo
-writeToRead = \case
-  WriteRepoGit repo -> ReadRepoGit (writeToReadGit repo)
-  WriteRepoShare repo -> ReadRepoShare repo
-
-writeToReadGit :: WriteGitRepo -> ReadGitRepo
-writeToReadGit = \case
-  WriteGitRepo {url, branch} -> ReadGitRepo {url = url, ref = branch}
-
 writeNamespaceToRead :: WriteRemoteNamespace Void -> ReadRemoteNamespace void
 writeNamespaceToRead = \case
-  WriteRemoteNamespaceGit WriteGitRemoteNamespace {repo, path} ->
-    ReadRemoteNamespaceGit ReadGitRemoteNamespace {repo = writeToReadGit repo, sch = Nothing, path}
   WriteRemoteNamespaceShare WriteShareRemoteNamespace {server, repo, path} ->
     ReadShare'LooseCode ReadShareLooseCode {server, repo, path}
   WriteRemoteProjectBranch v -> absurd v
 
-printReadGitRepo :: ReadGitRepo -> Text
-printReadGitRepo ReadGitRepo {url, ref} =
-  "git(" <> url <> Monoid.fromMaybe (Text.cons ':' <$> ref) <> ")"
-
-printWriteGitRepo :: WriteGitRepo -> Text
-printWriteGitRepo WriteGitRepo {url, branch} = "git(" <> url <> Monoid.fromMaybe (Text.cons ':' <$> branch) <> ")"
-
 -- | print remote namespace
 printReadRemoteNamespace :: (a -> Text) -> ReadRemoteNamespace a -> Text
 printReadRemoteNamespace printProject = \case
-  ReadRemoteNamespaceGit ReadGitRemoteNamespace {repo, sch, path} ->
-    printReadGitRepo repo <> maybePrintSCH sch <> maybePrintPath path
-    where
-      maybePrintSCH = \case
-        Nothing -> mempty
-        Just sch -> "#" <> SCH.toText sch
   ReadShare'LooseCode ReadShareLooseCode {server, repo, path} -> displayShareCodeserver server repo path
   ReadShare'ProjectBranch project -> printProject project
 
 -- | Render a 'WriteRemoteNamespace' as text.
 printWriteRemoteNamespace :: WriteRemoteNamespace (ProjectAndBranch ProjectName ProjectBranchName) -> Text
 printWriteRemoteNamespace = \case
-  WriteRemoteNamespaceGit (WriteGitRemoteNamespace {repo, path}) ->
-    printWriteGitRepo repo <> maybePrintPath path
   WriteRemoteNamespaceShare (WriteShareRemoteNamespace {server, repo, path}) ->
     displayShareCodeserver server repo path
   WriteRemoteProjectBranch projectAndBranch -> into @Text projectAndBranch
@@ -107,20 +61,12 @@ maybePrintPath path =
     else "." <> Path.toText path
 
 data ReadRemoteNamespace a
-  = ReadRemoteNamespaceGit !ReadGitRemoteNamespace
-  | ReadShare'LooseCode !ReadShareLooseCode
+  = ReadShare'LooseCode !ReadShareLooseCode
   | -- | A remote project+branch, specified by name (e.g. @unison/base/main).
     -- Currently assumed to be hosted on Share, though we could include a ShareCodeserver in here, too.
     ReadShare'ProjectBranch !a
   deriving stock (Eq, Functor, Show, Generic)
 
-data ReadGitRemoteNamespace = ReadGitRemoteNamespace
-  { repo :: !ReadGitRepo,
-    sch :: !(Maybe ShortCausalHash),
-    path :: !Path
-  }
-  deriving stock (Eq, Show)
-
 data ReadShareLooseCode = ReadShareLooseCode
   { server :: !ShareCodeserver,
     repo :: !ShareUserHandle,
@@ -136,8 +82,7 @@ isPublic ReadShareLooseCode {path} =
     _ -> False
 
 data WriteRemoteNamespace a
-  = WriteRemoteNamespaceGit !WriteGitRemoteNamespace
-  | WriteRemoteNamespaceShare !WriteShareRemoteNamespace
+  = WriteRemoteNamespaceShare !WriteShareRemoteNamespace
   | WriteRemoteProjectBranch a
   deriving stock (Eq, Functor, Show)
 
@@ -146,23 +91,14 @@ remotePath_ :: Lens' (WriteRemoteNamespace Void) Path
 remotePath_ = Lens.lens getter setter
   where
     getter = \case
-      WriteRemoteNamespaceGit (WriteGitRemoteNamespace _ path) -> path
       WriteRemoteNamespaceShare (WriteShareRemoteNamespace _ _ path) -> path
       WriteRemoteProjectBranch v -> absurd v
     setter remote path =
       case remote of
-        WriteRemoteNamespaceGit (WriteGitRemoteNamespace repo _) ->
-          WriteRemoteNamespaceGit $ WriteGitRemoteNamespace repo path
         WriteRemoteNamespaceShare (WriteShareRemoteNamespace server repo _) ->
           WriteRemoteNamespaceShare $ WriteShareRemoteNamespace server repo path
         WriteRemoteProjectBranch v -> absurd v
 
-data WriteGitRemoteNamespace = WriteGitRemoteNamespace
-  { repo :: !WriteGitRepo,
-    path :: !Path
-  }
-  deriving stock (Eq, Generic, Show)
-
 data WriteShareRemoteNamespace = WriteShareRemoteNamespace
   { server :: !ShareCodeserver,
     repo :: !ShareUserHandle,

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

@@ -14,17 +14,19 @@ import Unison.Codebase.MainTerm (getMainTerm)
 import Unison.Codebase.MainTerm qualified as MainTerm
 import Unison.Codebase.Runtime (Runtime)
 import Unison.Codebase.Runtime qualified as Runtime
+import Unison.HashQualified qualified as HQ
+import Unison.Name (Name)
 import Unison.Names qualified as Names
 import Unison.Parser.Ann (Ann)
-import Unison.Prelude
 import Unison.PrettyPrintEnv qualified as PPE
 import Unison.Symbol (Symbol)
+import Unison.Syntax.HashQualified qualified as HQ (toText)
 import Unison.Util.Pretty qualified as P
 
 execute ::
   Codebase.Codebase IO Symbol Ann ->
   Runtime Symbol ->
-  Text ->
+  HQ.HashQualified Name ->
   IO (Either Runtime.Error ())
 execute codebase runtime mainName =
   (`finally` Runtime.terminate runtime) . runExceptT $ do
@@ -34,9 +36,8 @@ execute codebase runtime mainName =
     let mainType = Runtime.mainType runtime
     mt <- liftIO $ Codebase.runTransaction codebase $ getMainTerm loadTypeOfTerm parseNames mainName mainType
     case mt of
-      MainTerm.NotAFunctionName s -> throwError ("Not a function name: " <> P.text s)
-      MainTerm.NotFound s -> throwError ("Not found: " <> P.text s)
-      MainTerm.BadType s _ -> throwError (P.text s <> " is not of type '{IO} ()")
+      MainTerm.NotFound s -> throwError ("Not found: " <> P.text (HQ.toText s))
+      MainTerm.BadType s _ -> throwError (P.text (HQ.toText s) <> " is not of type '{IO} ()")
       MainTerm.Success _ tm _ -> do
         let codeLookup = Codebase.toCodeLookup codebase
             ppe = PPE.empty

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

@@ -1,37 +0,0 @@
-module Unison.Codebase.GitError
-  ( CodebasePath,
-    GitProtocolError (..),
-    GitCodebaseError (..),
-  )
-where
-
-import Unison.Codebase.Editor.RemoteRepo (ReadGitRepo, WriteGitRepo)
-import Unison.Codebase.Path (Path)
-import Unison.Codebase.ShortCausalHash (ShortCausalHash)
-import Unison.Prelude
-
-type CodebasePath = FilePath
-
-data GitProtocolError
-  = NoGit
-  | UnrecognizableCacheDir ReadGitRepo CodebasePath
-  | UnrecognizableCheckoutDir ReadGitRepo CodebasePath
-  | --            srcPath  destPath error-description
-    CopyException FilePath FilePath String
-  | CloneException ReadGitRepo String
-  | PushException WriteGitRepo String
-  | PushNoOp WriteGitRepo
-  | -- url commit Diff of what would change on merge with remote
-    PushDestinationHasNewStuff WriteGitRepo
-  | CleanupError SomeException
-  | -- Thrown when a commit, tag, or branch isn't found in a repo.
-    --                repo ref
-    RemoteRefNotFound Text Text
-  deriving stock (Show)
-  deriving anyclass (Exception)
-
-data GitCodebaseError h
-  = NoRemoteNamespaceWithHash ReadGitRepo ShortCausalHash
-  | RemoteNamespaceHashAmbiguous ReadGitRepo ShortCausalHash (Set h)
-  | CouldntFindRemoteBranch ReadGitRepo Path
-  deriving (Show)

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

@@ -16,7 +16,6 @@ import Unison.Parser.Ann qualified as Parser.Ann
 import Unison.Prelude
 import Unison.Reference (Reference)
 import Unison.Referent qualified as Referent
-import Unison.Syntax.HashQualified qualified as HQ (parseText)
 import Unison.Term (Term)
 import Unison.Term qualified as Term
 import Unison.Type (Type)
@@ -26,37 +25,33 @@ import Unison.Var (Var)
 import Unison.Var qualified as Var
 
 data MainTerm v
-  = NotAFunctionName Text
-  | NotFound Text
-  | BadType Text (Maybe (Type v Ann))
+  = NotFound (HQ.HashQualified Name)
+  | BadType (HQ.HashQualified Name) (Maybe (Type v Ann))
   | Success (HQ.HashQualified Name) (Term v Ann) (Type v Ann)
 
 getMainTerm ::
   (Monad m, Var v) =>
   (Reference -> m (Maybe (Type v Ann))) ->
   Names.Names ->
-  Text ->
+  HQ.HashQualified Name ->
   Type.Type v Ann ->
   m (MainTerm v)
-getMainTerm loadTypeOfTerm parseNames mainName mainType =
-  case HQ.parseText mainName of
-    Nothing -> pure (NotAFunctionName mainName)
-    Just hq -> do
-      let refs = Names.lookupHQTerm Names.IncludeSuffixes hq parseNames
-      let a = Parser.Ann.External
-      case toList refs of
-        [] -> pure (NotFound mainName)
-        [Referent.Ref ref] -> do
-          typ <- loadTypeOfTerm ref
-          case typ of
-            Just typ ->
-              if Typechecker.fitsScheme typ mainType
-                then do
-                  let tm = DD.forceTerm a a (Term.ref a ref)
-                  return (Success hq tm typ)
-                else pure (BadType mainName $ Just typ)
-            _ -> pure (BadType mainName Nothing)
-        _ -> pure (error "multiple matching refs") -- TODO: make a real exception
+getMainTerm loadTypeOfTerm parseNames mainName mainType = do
+  let refs = Names.lookupHQTerm Names.IncludeSuffixes mainName parseNames
+  let a = Parser.Ann.External
+  case toList refs of
+    [] -> pure (NotFound mainName)
+    [Referent.Ref ref] -> do
+      typ <- loadTypeOfTerm ref
+      case typ of
+        Just typ ->
+          if Typechecker.fitsScheme typ mainType
+            then do
+              let tm = DD.forceTerm a a (Term.ref a ref)
+              return (Success mainName tm typ)
+            else pure (BadType mainName $ Just typ)
+        _ -> pure (BadType mainName Nothing)
+    _ -> pure (error "multiple matching refs") -- TODO: make a real exception
 
 -- forall x. '{ io2.IO, Exception } x
 builtinMain :: (Var v) => a -> Type.Type v a

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

@@ -2,6 +2,7 @@ module Unison.Codebase.ShortCausalHash
   ( toString,
     toHash,
     fromHash,
+    fromFullHash,
     fromText,
     ShortCausalHash (..),
   )
@@ -27,6 +28,14 @@ fromHash :: (Coercible h Hash.Hash) => Int -> h -> ShortCausalHash
 fromHash len =
   ShortCausalHash . Text.take len . Hash.toBase32HexText . coerce
 
+-- | This allows a full hash to be preserved as a `ShortCausalHash`.
+--
+--  `ShortCausalHash` is used for input when we expect a user to enter a hash on the command line, so they aren’t
+--   required to enter the full hash. However, these inputs may also come from an internal source, and in such cases,
+--   there is no reason to truncate the hash.
+fromFullHash :: (Coercible h Hash.Hash) => h -> ShortCausalHash
+fromFullHash = ShortCausalHash . Hash.toBase32HexText . coerce
+
 -- abc -> SCH abc
 -- #abc -> SCH abc
 fromText :: Text -> Maybe ShortCausalHash

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

@@ -14,17 +14,13 @@ where
 
 import Control.Monad.Except qualified as Except
 import Control.Monad.Extra qualified as Monad
-import Data.Char qualified as Char
 import Data.Either.Extra ()
 import Data.IORef
 import Data.Map qualified as Map
 import Data.Set qualified as Set
-import Data.Text qualified as Text
 import Data.Time (getCurrentTime)
 import System.Console.ANSI qualified as ANSI
 import System.FileLock (SharedExclusive (Exclusive), withTryFileLock)
-import System.FilePath qualified as FilePath
-import System.FilePath.Posix qualified as FilePath.Posix
 import U.Codebase.HashTags (CausalHash, PatchHash (..))
 import U.Codebase.Reflog qualified as Reflog
 import U.Codebase.Sqlite.Operations qualified as Ops
@@ -36,15 +32,6 @@ import Unison.Codebase (Codebase, CodebasePath)
 import Unison.Codebase qualified as Codebase1
 import Unison.Codebase.Branch (Branch (..))
 import Unison.Codebase.Branch qualified as Branch
-import Unison.Codebase.Editor.Git (gitIn, gitInCaptured, gitTextIn, withRepo)
-import Unison.Codebase.Editor.Git qualified as Git
-import Unison.Codebase.Editor.RemoteRepo
-  ( ReadGitRemoteNamespace (..),
-    ReadGitRepo,
-    WriteGitRepo (..),
-    writeToReadGit,
-  )
-import Unison.Codebase.GitError qualified as GitError
 import Unison.Codebase.Init (BackupStrategy (..), CodebaseLockOption (..), MigrationStrategy (..), VacuumStrategy (..))
 import Unison.Codebase.Init qualified as Codebase
 import Unison.Codebase.Init.CreateCodebaseError qualified as Codebase1
@@ -54,12 +41,11 @@ import Unison.Codebase.RootBranchCache
 import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache)
 import Unison.Codebase.SqliteCodebase.Branch.Dependencies qualified as BD
 import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
-import Unison.Codebase.SqliteCodebase.GitError qualified as GitError
 import Unison.Codebase.SqliteCodebase.Migrations qualified as Migrations
 import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps
 import Unison.Codebase.SqliteCodebase.Paths
 import Unison.Codebase.SqliteCodebase.SyncEphemeral qualified as SyncEphemeral
-import Unison.Codebase.Type (GitPushBehavior, LocalOrRemote (..))
+import Unison.Codebase.Type (LocalOrRemote (..))
 import Unison.Codebase.Type qualified as C
 import Unison.DataDeclaration (Decl)
 import Unison.Hash (Hash)
@@ -75,9 +61,8 @@ import Unison.Term (Term)
 import Unison.Type (Type)
 import Unison.Util.Timing (time)
 import Unison.WatchKind qualified as UF
-import UnliftIO (UnliftIO (..), finally, throwIO, try)
+import UnliftIO (UnliftIO (..), finally)
 import UnliftIO.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
-import UnliftIO.Exception (catch)
 import UnliftIO.STM
 
 debug, debugProcessBranches :: Bool
@@ -103,30 +88,6 @@ initWithSetup onCreate =
       codebasePath = makeCodebaseDirPath
     }
 
-data CodebaseStatus
-  = ExistingCodebase
-  | CreatedCodebase
-  deriving (Eq)
-
--- | Open the codebase at the given location, or create it if one doesn't already exist.
-withOpenOrCreateCodebase ::
-  (MonadUnliftIO m) =>
-  Sqlite.Transaction () ->
-  Codebase.DebugName ->
-  CodebasePath ->
-  LocalOrRemote ->
-  CodebaseLockOption ->
-  MigrationStrategy ->
-  ((CodebaseStatus, Codebase m Symbol Ann) -> m r) ->
-  m (Either Codebase1.OpenCodebaseError r)
-withOpenOrCreateCodebase onCreate debugName codebasePath localOrRemote lockOption migrationStrategy action = do
-  createCodebaseOrError onCreate debugName codebasePath lockOption (action' CreatedCodebase) >>= \case
-    Left (Codebase1.CreateCodebaseAlreadyExists) -> do
-      sqliteCodebase debugName codebasePath localOrRemote lockOption migrationStrategy (action' ExistingCodebase)
-    Right r -> pure (Right r)
-  where
-    action' openOrCreate codebase = action (openOrCreate, codebase)
-
 -- | Create a codebase at the given location.
 createCodebaseOrError ::
   (MonadUnliftIO m) =>
@@ -379,8 +340,6 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action
                   putBranch,
                   syncFromDirectory,
                   syncToDirectory,
-                  viewRemoteBranch',
-                  pushGitBranch = \repo opts action -> withConn \conn -> pushGitBranch conn repo opts action,
                   getWatch,
                   termsOfTypeImpl,
                   termsMentioningTypeImpl,
@@ -571,214 +530,6 @@ syncProgress progressStateRef = Sync.Progress (liftIO . need) (liftIO . done) (l
       where
         v = const ()
 
--- FIXME(mitchell) seems like this should have "git" in its name
-viewRemoteBranch' ::
-  forall m r.
-  (MonadUnliftIO m) =>
-  ReadGitRemoteNamespace ->
-  Git.GitBranchBehavior ->
-  ((Branch m, CodebasePath) -> m r) ->
-  m (Either C.GitError r)
-viewRemoteBranch' ReadGitRemoteNamespace {repo, sch, path} gitBranchBehavior action = UnliftIO.try $ do
-  -- set up the cache dir
-  time "Git fetch" $
-    throwEitherMWith C.GitProtocolError . withRepo repo gitBranchBehavior $ \remoteRepo -> do
-      let remotePath = Git.gitDirToPath remoteRepo
-          -- In modern UCM all new codebases are created in WAL mode, but it's possible old
-          -- codebases were pushed to git in DELETE mode, so when pulling remote branches we
-          -- ensure we're in WAL mode just to be safe.
-          ensureWALMode conn = Sqlite.trySetJournalMode conn Sqlite.JournalMode'WAL
-      -- Tickle the database before calling into `sqliteCodebase`; this covers the case that the database file either
-      -- doesn't exist at all or isn't a SQLite database file, but does not cover the case that the database file itself
-      -- is somehow corrupt, or not even a Unison database.
-      --
-      -- FIXME it would probably make more sense to define some proper preconditions on `sqliteCodebase`, and perhaps
-      -- update its output type, which currently indicates the only way it can fail is with an `UnknownSchemaVersion`
-      -- error.
-      (withConnection "codebase exists check" remotePath ensureWALMode) `catch` \exception ->
-        if Sqlite.isCantOpenException exception
-          then throwIO (C.GitSqliteCodebaseError (GitError.NoDatabaseFile repo remotePath))
-          else throwIO exception
-
-      result <- sqliteCodebase "viewRemoteBranch.gitCache" remotePath Remote DoLock (MigrateAfterPrompt Codebase.Backup Codebase.Vacuum) \codebase -> do
-        -- try to load the requested branch from it
-        branch <- time "Git fetch (sch)" $ case sch of
-          -- no sub-branch was specified, so use the root.
-          Nothing -> time "Get remote root branch" $ Codebase1.getRootBranch codebase
-          -- load from a specific `ShortCausalHash`
-          Just sch -> do
-            branchCompletions <- Codebase1.runTransaction codebase (Codebase1.causalHashesByPrefix sch)
-            case toList branchCompletions of
-              [] -> throwIO . C.GitCodebaseError $ GitError.NoRemoteNamespaceWithHash repo sch
-              [h] ->
-                (Codebase1.getBranchForHash codebase h) >>= \case
-                  Just b -> pure b
-                  Nothing -> throwIO . C.GitCodebaseError $ GitError.NoRemoteNamespaceWithHash repo sch
-              _ -> throwIO . C.GitCodebaseError $ GitError.RemoteNamespaceHashAmbiguous repo sch branchCompletions
-        case Branch.getAt path branch of
-          Just b -> action (b, remotePath)
-          Nothing -> throwIO . C.GitCodebaseError $ GitError.CouldntFindRemoteBranch repo path
-      case result of
-        Left err -> throwIO . C.GitSqliteCodebaseError $ C.gitErrorFromOpenCodebaseError remotePath repo err
-        Right inner -> pure inner
-
--- | Push a branch to a repo. Optionally attempt to set the branch as the new root, which fails if the branch is not after
--- the existing root.
-pushGitBranch ::
-  forall m e.
-  (MonadUnliftIO m) =>
-  Sqlite.Connection ->
-  WriteGitRepo ->
-  GitPushBehavior ->
-  -- An action which accepts the current root branch on the remote and computes a new branch.
-  (Branch m -> m (Either e (Branch m))) ->
-  m (Either C.GitError (Either e (Branch m)))
-pushGitBranch srcConn repo behavior action = UnliftIO.try do
-  -- Pull the latest remote into our git cache
-  -- Use a local git clone to copy this git repo into a temp-dir
-  -- Delete the codebase in our temp-dir
-  -- Use sqlite's VACUUM INTO command to make a copy of the remote codebase into our temp-dir
-  -- Connect to the copied codebase and sync whatever it is we want to push.
-  -- sync the branch to the staging codebase using `syncInternal`, which probably needs to be passed in instead of `syncToDirectory`
-  -- if setting the remote root,
-  --   do a `before` check on the staging codebase
-  --   if it passes, proceed (see below)
-  --   if it fails, throw an exception (which will rollback) and clean up.
-  -- push from the temp-dir to the remote.
-  -- Delete the temp-dir.
-  --
-  -- set up the cache dir
-  throwEitherMWith C.GitProtocolError . withRepo readRepo Git.CreateBranchIfMissing $ \pushStaging -> do
-    newBranchOrErr <- throwEitherMWith (C.GitSqliteCodebaseError . C.gitErrorFromOpenCodebaseError (Git.gitDirToPath pushStaging) readRepo)
-      . withOpenOrCreateCodebase (pure ()) "push.dest" (Git.gitDirToPath pushStaging) Remote DoLock (MigrateAfterPrompt Codebase.Backup Codebase.Vacuum)
-      $ \(codebaseStatus, destCodebase) -> do
-        currentRootBranch <-
-          Codebase1.runTransaction destCodebase CodebaseOps.getRootBranchExists >>= \case
-            False -> pure Branch.empty
-            True -> C.getRootBranch destCodebase
-        action currentRootBranch >>= \case
-          Left e -> pure $ Left e
-          Right newBranch -> do
-            C.withConnection destCodebase \destConn ->
-              doSync codebaseStatus destConn newBranch
-            pure (Right newBranch)
-    for newBranchOrErr $ push pushStaging repo
-    pure newBranchOrErr
-  where
-    readRepo :: ReadGitRepo
-    readRepo = writeToReadGit repo
-    doSync :: CodebaseStatus -> Sqlite.Connection -> Branch m -> m ()
-    doSync codebaseStatus destConn newBranch = do
-      progressStateRef <- liftIO (newIORef emptySyncProgressState)
-      Sqlite.runReadOnlyTransaction srcConn \runSrc -> do
-        Sqlite.runWriteTransaction destConn \runDest -> do
-          _ <- syncInternal (syncProgress progressStateRef) runSrc runDest newBranch
-          let overwriteRoot forcePush = do
-                let newBranchHash = Branch.headHash newBranch
-                case codebaseStatus of
-                  ExistingCodebase -> do
-                    when (not forcePush) do
-                      -- the call to runDB "handles" the possible DB error by bombing
-                      runDest Ops.loadRootCausalHash >>= \case
-                        Nothing -> pure ()
-                        Just oldRootHash -> do
-                          runDest (CodebaseOps.before oldRootHash newBranchHash) >>= \case
-                            False -> throwIO . C.GitProtocolError $ GitError.PushDestinationHasNewStuff repo
-                            True -> pure ()
-                  CreatedCodebase -> pure ()
-                runDest (setRepoRoot newBranchHash)
-          case behavior of
-            C.GitPushBehaviorGist -> pure ()
-            C.GitPushBehaviorFf -> overwriteRoot False
-            C.GitPushBehaviorForce -> overwriteRoot True
-    setRepoRoot :: CausalHash -> Sqlite.Transaction ()
-    setRepoRoot h = do
-      let err = error $ "Called SqliteCodebase.setNamespaceRoot on unknown causal hash " ++ show h
-      chId <- fromMaybe err <$> Q.loadCausalHashIdByCausalHash h
-      Q.setNamespaceRoot chId
-
-    -- This function makes sure that the result of git status is valid.
-    -- Valid lines are any of:
-    --
-    --   ?? .unison/v2/unison.sqlite3 (initial commit to an empty repo)
-    --   M .unison/v2/unison.sqlite3  (updating an existing repo)
-    --   D .unison/v2/unison.sqlite3-wal (cleaning up the WAL from before bugfix)
-    --   D .unison/v2/unison.sqlite3-shm (ditto)
-    --
-    -- Invalid lines are like:
-    --
-    --   ?? .unison/v2/unison.sqlite3-wal
-    --
-    -- Which will only happen if the write-ahead log hasn't been
-    -- fully folded into the unison.sqlite3 file.
-    --
-    -- Returns `Just (hasDeleteWal, hasDeleteShm)` on success,
-    -- `Nothing` otherwise. hasDeleteWal means there's the line:
-    --   D .unison/v2/unison.sqlite3-wal
-    -- and hasDeleteShm is `True` if there's the line:
-    --   D .unison/v2/unison.sqlite3-shm
-    --
-    parseStatus :: Text -> Maybe (Bool, Bool)
-    parseStatus status =
-      if all okLine statusLines
-        then Just (hasDeleteWal, hasDeleteShm)
-        else Nothing
-      where
-        -- `git status` always displays paths using posix forward-slashes,
-        -- so we have to convert our expected path to test.
-        posixCodebasePath =
-          FilePath.Posix.joinPath (FilePath.splitDirectories codebasePath)
-        posixLockfilePath = FilePath.replaceExtension posixCodebasePath "lockfile"
-        statusLines = Text.unpack <$> Text.lines status
-        t = dropWhile Char.isSpace
-        okLine (t -> '?' : '?' : (t -> p)) | p == posixCodebasePath || p == posixLockfilePath = True
-        okLine (t -> 'M' : (t -> p)) | p == posixCodebasePath = True
-        okLine line = isWalDelete line || isShmDelete line
-        isWalDelete (t -> 'D' : (t -> p)) | p == posixCodebasePath ++ "-wal" = True
-        isWalDelete _ = False
-        isShmDelete (t -> 'D' : (t -> p)) | p == posixCodebasePath ++ "-wal" = True
-        isShmDelete _ = False
-        hasDeleteWal = any isWalDelete statusLines
-        hasDeleteShm = any isShmDelete statusLines
-
-    -- Commit our changes
-    push :: forall n. (MonadIO n) => Git.GitRepo -> WriteGitRepo -> Branch m -> n Bool -- withIOError needs IO
-    push remotePath repo@(WriteGitRepo {url, branch = mayGitBranch}) newRootBranch = time "SqliteCodebase.pushGitRootBranch.push" $ do
-      -- has anything changed?
-      -- note: -uall recursively shows status for all files in untracked directories
-      --   we want this so that we see
-      --     `??  .unison/v2/unison.sqlite3` and not
-      --     `??  .unison/`
-      status <- gitTextIn remotePath ["status", "--short", "-uall"]
-      if Text.null status
-        then pure False
-        else case parseStatus status of
-          Nothing ->
-            error $
-              "An error occurred during push.\n"
-                <> "I was expecting only to see "
-                <> codebasePath
-                <> " modified, but saw:\n\n"
-                <> Text.unpack status
-                <> "\n\n"
-                <> "Please visit https://github.com/unisonweb/unison/issues/2063\n"
-                <> "and add any more details about how you encountered this!\n"
-          Just (hasDeleteWal, hasDeleteShm) -> do
-            -- Only stage files we're expecting; don't `git add --all .`
-            -- which could accidentally commit some garbage
-            gitIn remotePath ["add", Text.pack codebasePath]
-            when hasDeleteWal $ gitIn remotePath ["rm", Text.pack $ codebasePath <> "-wal"]
-            when hasDeleteShm $ gitIn remotePath ["rm", Text.pack $ codebasePath <> "-shm"]
-            gitIn
-              remotePath
-              ["commit", "-q", "-m", "Sync branch " <> Text.pack (show $ Branch.headHash newRootBranch)]
-            -- Push our changes to the repo, silencing all output.
-            -- Even with quiet, the remote (Github) can still send output through,
-            -- so we capture stdout and stderr.
-            (successful, _stdout, stderr) <- gitInCaptured remotePath $ ["push", url] ++ Git.gitVerbosity ++ maybe [] (pure @[]) mayGitBranch
-            when (not successful) . throwIO $ GitError.PushException repo (Text.unpack stderr)
-            pure True
-
 -- | Given two codebase roots (e.g. "./mycodebase"), safely copy the codebase
 -- at the source to the destination.
 -- Note: this does not copy the .unisonConfig file.

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

@@ -1,13 +0,0 @@
-module Unison.Codebase.SqliteCodebase.GitError where
-
-import U.Codebase.Sqlite.DbId (SchemaVersion)
-import Unison.Codebase.Editor.RemoteRepo (ReadGitRepo)
-import Unison.CodebasePath (CodebasePath)
-
-data GitSqliteCodebaseError
-  = GitCouldntParseRootBranchHash ReadGitRepo String
-  | CodebaseFileLockFailed
-  | NoDatabaseFile ReadGitRepo CodebasePath
-  | UnrecognizedSchemaVersion ReadGitRepo CodebasePath SchemaVersion
-  | CodebaseRequiresMigration SchemaVersion SchemaVersion
-  deriving (Show)

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/Codebase/Type.hs

@@ -4,21 +4,13 @@
 module Unison.Codebase.Type
   ( Codebase (..),
     CodebasePath,
-    GitPushBehavior (..),
-    GitError (..),
     LocalOrRemote (..),
-    gitErrorFromOpenCodebaseError,
   )
 where
 
 import U.Codebase.HashTags (CausalHash)
 import U.Codebase.Reference qualified as V2
 import Unison.Codebase.Branch (Branch)
-import Unison.Codebase.Editor.Git qualified as Git
-import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace, ReadGitRepo, WriteGitRepo)
-import Unison.Codebase.GitError (GitCodebaseError, GitProtocolError)
-import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (..))
-import Unison.Codebase.SqliteCodebase.GitError (GitSqliteCodebaseError (..))
 import Unison.CodebasePath (CodebasePath)
 import Unison.ConstructorType qualified as CT
 import Unison.DataDeclaration (Decl)
@@ -80,9 +72,6 @@ data Codebase m v a = Codebase
     syncFromDirectory :: CodebasePath -> Branch m -> m (),
     -- | Copy a branch and all of its dependencies from this codebase into the given codebase.
     syncToDirectory :: CodebasePath -> Branch m -> m (),
-    viewRemoteBranch' :: forall r. ReadGitRemoteNamespace -> Git.GitBranchBehavior -> ((Branch m, CodebasePath) -> m r) -> m (Either GitError r),
-    -- | Push the given branch to the given repo, and optionally set it as the root branch.
-    pushGitBranch :: forall e. WriteGitRepo -> GitPushBehavior -> (Branch m -> m (Either e (Branch m))) -> m (Either GitError (Either e (Branch m))),
     -- | @getWatch k r@ returns watch result @t@ that was previously put by @putWatch k r t@.
     getWatch :: WK.WatchKind -> Reference.Id -> Sqlite.Transaction (Maybe (Term v a)),
     -- | Get the set of user-defined terms-or-constructors that have the given type.
@@ -106,28 +95,3 @@ data LocalOrRemote
   = Local
   | Remote
   deriving (Show, Eq, Ord)
-
-data GitPushBehavior
-  = -- | Don't set root, just sync entities.
-    GitPushBehaviorGist
-  | -- | After syncing entities, do a fast-forward check, then set the root.
-    GitPushBehaviorFf
-  | -- | After syncing entities, just set the root (force-pushy).
-    GitPushBehaviorForce
-
-data GitError
-  = GitProtocolError GitProtocolError
-  | GitCodebaseError (GitCodebaseError CausalHash)
-  | GitSqliteCodebaseError GitSqliteCodebaseError
-  deriving (Show)
-
-instance Exception GitError
-
-gitErrorFromOpenCodebaseError :: CodebasePath -> ReadGitRepo -> OpenCodebaseError -> GitSqliteCodebaseError
-gitErrorFromOpenCodebaseError path repo = \case
-  OpenCodebaseDoesntExist -> NoDatabaseFile repo path
-  OpenCodebaseUnknownSchemaVersion v ->
-    UnrecognizedSchemaVersion repo path (fromIntegral v)
-  OpenCodebaseRequiresMigration fromSv toSv ->
-    CodebaseRequiresMigration fromSv toSv
-  OpenCodebaseFileLockFailed -> CodebaseFileLockFailed

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

@@ -142,11 +142,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)
 
@@ -201,7 +201,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"),
@@ -290,7 +290,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
@@ -1058,7 +1058,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/Convert.hs

@@ -1,10 +0,0 @@
-module Unison.Util.Convert where
-
-class Convert a b where
-  convert :: a -> b
-
-class Parse a b where
-  parse :: a -> Maybe b
-
-instance (Parse a a2, Parse b b2) => Parse (a, b) (a2, b2) where
-  parse (a, b) = (,) <$> parse a <*> parse b

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

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
@@ -47,11 +47,9 @@ library
       Unison.Codebase.CodeLookup
       Unison.Codebase.CodeLookup.Util
       Unison.Codebase.Editor.DisplayObject
-      Unison.Codebase.Editor.Git
       Unison.Codebase.Editor.RemoteRepo
       Unison.Codebase.Execute
       Unison.Codebase.FileCodebase
-      Unison.Codebase.GitError
       Unison.Codebase.Init
       Unison.Codebase.Init.CreateCodebaseError
       Unison.Codebase.Init.OpenCodebaseError
@@ -71,7 +69,6 @@ library
       Unison.Codebase.SqliteCodebase.Branch.Cache
       Unison.Codebase.SqliteCodebase.Branch.Dependencies
       Unison.Codebase.SqliteCodebase.Conversions
-      Unison.Codebase.SqliteCodebase.GitError
       Unison.Codebase.SqliteCodebase.Migrations
       Unison.Codebase.SqliteCodebase.Migrations.Helpers
       Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema11To12
@@ -178,14 +175,12 @@ library
       Unison.UnisonFile.Names
       Unison.UnisonFile.Summary
       Unison.UnisonFile.Type
-      Unison.Util.Convert
       Unison.Util.CycleTable
       Unison.Util.CyclicEq
       Unison.Util.CyclicOrd
       Unison.Util.EnumContainers
       Unison.Util.Exception
       Unison.Util.Logger
-      Unison.Util.PinBoard
       Unison.Util.Pretty.MegaParsec
       Unison.Util.RefPromise
       Unison.Util.Star2
@@ -385,7 +380,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/ArgParse.hs

@@ -17,6 +17,7 @@ import Options.Applicative
     ParserPrefs,
     ReadM,
     action,
+    argument,
     auto,
     columns,
     command,
@@ -32,6 +33,7 @@ import Options.Applicative
     info,
     infoOption,
     long,
+    maybeReader,
     metavar,
     option,
     parserFailure,
@@ -53,21 +55,21 @@ import System.Environment (lookupEnv)
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Path.Parse qualified as Path
 import Unison.CommandLine.Types (ShouldWatchFiles (..))
+import Unison.HashQualified (HashQualified)
 import Unison.LSP (LspFormattingConfig (..))
+import Unison.Name (Name)
 import Unison.Prelude
 import Unison.PrettyTerminal qualified as PT
 import Unison.Server.CodebaseServer (CodebaseServerOpts (..))
 import Unison.Server.CodebaseServer qualified as Server
+import Unison.Syntax.HashQualified qualified as HQ
 import Unison.Util.Pretty (Width (..))
 
--- The name of a symbol to execute.
-type SymbolName = Text
-
 -- | Valid ways to provide source code to the run command
 data RunSource
-  = RunFromPipe SymbolName
-  | RunFromSymbol SymbolName
-  | RunFromFile FilePath SymbolName
+  = RunFromPipe (HashQualified Name)
+  | RunFromSymbol (HashQualified Name)
+  | RunFromFile FilePath (HashQualified Name)
   | RunCompiled FilePath
   deriving (Show, Eq)
 
@@ -368,22 +370,26 @@ versionParser = pure PrintVersion
 runArgumentParser :: Parser [String]
 runArgumentParser = many (strArgument (metavar "RUN-ARGS"))
 
+runHQParser :: Parser (HashQualified Name)
+runHQParser =
+  argument (maybeReader (HQ.parseText . Text.pack)) (metavar "SYMBOL")
+
 runSymbolParser :: Parser Command
 runSymbolParser =
-  Run . RunFromSymbol <$> strArgument (metavar "SYMBOL") <*> runArgumentParser
+  Run . RunFromSymbol <$> runHQParser <*> runArgumentParser
 
 runFileParser :: Parser Command
 runFileParser =
   Run
     <$> ( RunFromFile
             <$> fileArgument "path/to/file"
-            <*> strArgument (metavar "SYMBOL")
+            <*> runHQParser
         )
     <*> runArgumentParser
 
 runPipeParser :: Parser Command
 runPipeParser =
-  Run . RunFromPipe <$> strArgument (metavar "SYMBOL") <*> runArgumentParser
+  Run . RunFromPipe <$> runHQParser <*> runArgumentParser
 
 runCompiledParser :: Parser Command
 runCompiledParser =

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

@@ -4,8 +4,6 @@
 module Unison.Cli.DownloadUtils
   ( downloadProjectBranchFromShare,
     downloadLooseCodeFromShare,
-    GitNamespaceHistoryTreatment (..),
-    downloadLooseCodeFromGitRepo,
   )
 where
 
@@ -18,27 +16,19 @@ import U.Codebase.Sqlite.Queries qualified as Queries
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.Share.Projects qualified as Share
-import Unison.Codebase (Codebase)
-import Unison.Codebase qualified as Codebase
-import Unison.Codebase.Branch qualified as Branch
-import Unison.Codebase.Editor.Git qualified as Git
 import Unison.Codebase.Editor.HandleInput.AuthLogin (ensureAuthenticatedWithCodeserver)
 import Unison.Codebase.Editor.Output qualified as Output
-import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace, ReadShareLooseCode, shareUserHandleToText)
+import Unison.Codebase.Editor.RemoteRepo (ReadShareLooseCode, shareUserHandleToText)
 import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
 import Unison.Codebase.Path qualified as Path
-import Unison.Codebase.Type (GitError)
-import Unison.Codebase.Type qualified as Codebase (viewRemoteBranch')
 import Unison.Core.Project (ProjectAndBranch (..))
 import Unison.NameSegment.Internal qualified as NameSegment
-import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.Share.API.Hash qualified as Share
 import Unison.Share.Codeserver qualified as Codeserver
 import Unison.Share.Sync qualified as Share
 import Unison.Share.Sync.Types qualified as Share
 import Unison.Share.Types (codeserverBaseURL)
-import Unison.Symbol (Symbol)
 import Unison.Sync.Common qualified as Sync.Common
 import Unison.Sync.Types qualified as Share
 
@@ -113,26 +103,3 @@ withEntitiesDownloadedProgressCallback action = do
             <> tShow entitiesDownloaded
             <> " entities...\n\n"
       action ((\n -> atomically (modifyTVar' entitiesDownloadedVar (+ n))), readTVarIO entitiesDownloadedVar)
-
-data GitNamespaceHistoryTreatment
-  = -- | Don't touch the history
-    GitNamespaceHistoryTreatment'LetAlone
-  | -- | Throw away all history at all levels
-    GitNamespaceHistoryTreatment'DiscardAllHistory
-
--- | Download loose code that's in a SQLite codebase in a Git repo.
-downloadLooseCodeFromGitRepo ::
-  MonadIO m =>
-  Codebase IO Symbol Ann ->
-  GitNamespaceHistoryTreatment ->
-  ReadGitRemoteNamespace ->
-  m (Either GitError CausalHash)
-downloadLooseCodeFromGitRepo codebase historyTreatment namespace = liftIO do
-  Codebase.viewRemoteBranch' codebase namespace Git.RequireExistingBranch \(branch0, cacheDir) -> do
-    let branch =
-          case historyTreatment of
-            GitNamespaceHistoryTreatment'LetAlone -> branch0
-            GitNamespaceHistoryTreatment'DiscardAllHistory -> Branch.discardHistory branch0
-
-    Codebase.syncFromDirectory codebase cacheDir branch
-    pure (Branch.headHash branch)

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

@@ -0,0 +1,31 @@
+-- | 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 (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
+
+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/MonadUtils.hs

@@ -67,9 +67,6 @@ module Unison.Cli.MonadUtils
 
     -- ** Getting patches
     getPatchAt,
-    getMaybePatchAt,
-    expectPatchAt,
-    assertNoPatchAt,
 
     -- * Latest touched Unison file
     getLatestFile,
@@ -514,16 +511,6 @@ getMaybePatchAt path0 = do
   branch <- getBranch0At path
   liftIO (Branch.getMaybePatch name branch)
 
--- | Get the patch at a path, or return early if there's no such patch.
-expectPatchAt :: Path.Split' -> Cli Patch
-expectPatchAt path =
-  getMaybePatchAt path & onNothingM (Cli.returnEarly (Output.PatchNotFound path))
-
--- | Assert that there's no patch at a path, or return early if there is one.
-assertNoPatchAt :: Path.Split' -> Cli ()
-assertNoPatchAt path = do
-  whenJustM (getMaybePatchAt path) \_ -> Cli.returnEarly (Output.PatchAlreadyExists path)
-
 ------------------------------------------------------------------------------------------------------------------------
 -- Latest (typechecked) unison file utils
 

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

@@ -19,13 +19,14 @@ module Unison.Cli.Pretty
     prettyLabeledDependencies,
     prettyPath,
     prettyPath',
+    prettyMergeSource,
+    prettyMergeSourceOrTarget,
     prettyProjectAndBranchName,
     prettyBranchName,
     prettyProjectBranchName,
     prettyProjectName,
     prettyProjectNameSlash,
     prettyNamespaceKey,
-    prettyReadGitRepo,
     prettyReadRemoteNamespace,
     prettyReadRemoteNamespaceWith,
     prettyRelative,
@@ -35,6 +36,7 @@ module Unison.Cli.Pretty
     prettySemver,
     prettyShareLink,
     prettySharePath,
+    prettyShareURI,
     prettySlashProjectBranchName,
     prettyTermName,
     prettyTypeName,
@@ -43,7 +45,6 @@ module Unison.Cli.Pretty
     prettyURI,
     prettyUnisonFile,
     prettyWhichBranchEmpty,
-    prettyWriteGitRepo,
     prettyWriteRemoteNamespace,
     shareOrigin,
     unsafePrettyTermResultSigFull',
@@ -69,16 +70,15 @@ 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))
 import Unison.Codebase.Editor.Input qualified as Input
 import Unison.Codebase.Editor.Output
 import Unison.Codebase.Editor.RemoteRepo
-  ( ReadGitRepo,
-    ReadRemoteNamespace,
+  ( ReadRemoteNamespace (..),
     ShareUserHandle (..),
-    WriteGitRepo,
     WriteRemoteNamespace (..),
     WriteShareRemoteNamespace (..),
     shareUserHandleToText,
@@ -137,6 +137,11 @@ type Pretty = P.Pretty P.ColorText
 prettyURI :: URI -> Pretty
 prettyURI = P.bold . P.blue . P.shown
 
+prettyShareURI :: URI -> Pretty
+prettyShareURI host
+  | URI.uriToString id host "" == "https://api.unison-lang.org" = P.bold (P.blue "Unison Share")
+  | otherwise = P.bold (P.blue (P.shown host))
+
 prettyReadRemoteNamespace :: ReadRemoteNamespace Share.RemoteProjectBranch -> Pretty
 prettyReadRemoteNamespace =
   prettyReadRemoteNamespaceWith \remoteProjectBranch ->
@@ -225,6 +230,17 @@ 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)
+
+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
@@ -327,18 +343,6 @@ prettyTypeName ppe r =
   P.syntaxToColor $
     prettyHashQualified (PPE.typeName ppe r)
 
-prettyReadGitRepo :: ReadGitRepo -> Pretty
-prettyReadGitRepo = \case
-  RemoteRepo.ReadGitRepo {url} -> P.blue (P.text url)
-
-prettyWriteGitRepo :: WriteGitRepo -> Pretty
-prettyWriteGitRepo RemoteRepo.WriteGitRepo {url} = P.blue (P.text url)
-
--- prettyWriteRepo :: WriteRepo -> Pretty
--- prettyWriteRepo = \case
---   RemoteRepo.WriteRepoGit RemoteRepo.WriteGitRepo {url} -> P.blue (P.text url)
---   RemoteRepo.WriteRepoShare s -> P.blue (P.text (RemoteRepo.printShareRepo s))
-
 -- | Pretty-print a 'WhichBranchEmpty'.
 prettyWhichBranchEmpty :: WhichBranchEmpty -> Pretty
 prettyWhichBranchEmpty = \case
@@ -346,8 +350,8 @@ prettyWhichBranchEmpty = \case
   WhichBranchEmptyPath path -> prettyPath' path
 
 -- | Displays a full, non-truncated Branch.CausalHash to a string, e.g. #abcdef
-displayBranchHash :: CausalHash -> String
-displayBranchHash = ("#" <>) . Text.unpack . Hash.toBase32HexText . unCausalHash
+displayBranchHash :: CausalHash -> Text
+displayBranchHash = ("#" <>) . Hash.toBase32HexText . unCausalHash
 
 prettyHumanReadableTime :: UTCTime -> UTCTime -> Pretty
 prettyHumanReadableTime now time =
@@ -379,15 +383,15 @@ prettyRemoteBranchInfo (host, remoteProject, remoteBranch) =
   -- Special-case Unison Share since we know its project branch URLs
   if URI.uriToString id host "" == "https://api.unison-lang.org"
     then
-      P.hiBlack . P.text $
+      P.group $
         "https://share.unison-lang.org/"
-          <> into @Text remoteProject
+          <> prettyProjectName remoteProject
           <> "/code/"
-          <> into @Text remoteBranch
+          <> prettyProjectBranchName remoteBranch
     else
       prettyProjectAndBranchName (ProjectAndBranch remoteProject remoteBranch)
         <> " on "
-        <> P.hiBlack (P.shown host)
+        <> P.shown host
 
 stripProjectBranchInfo :: Path.Absolute -> Maybe Path.Path
 stripProjectBranchInfo = fmap snd . preview projectBranchPathPrism

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

@@ -25,6 +25,7 @@ module Unison.Cli.ProjectUtils
     getProjectAndBranchByTheseNames,
     expectProjectAndBranchByTheseNames,
     expectLooseCodeOrProjectBranch,
+    getProjectBranchCausalHash,
 
     -- * Loading remote project info
     expectRemoteProjectById,
@@ -36,9 +37,17 @@ module Unison.Cli.ProjectUtils
     expectRemoteProjectBranchByNames,
     expectRemoteProjectBranchByTheseNames,
 
+    -- * Projecting out common things
+    justTheIds,
+    justTheIds',
+    justTheNames,
+
     -- * Other helpers
     findTemporaryBranchName,
     expectLatestReleaseBranchName,
+
+    -- * Upgrade branch utils
+    getUpgradeBranchParent,
   )
 where
 
@@ -46,7 +55,10 @@ import Control.Lens
 import Data.List qualified as List
 import Data.Maybe (fromJust)
 import Data.Set qualified as Set
+import Data.Text qualified as Text
 import Data.These (These (..))
+import U.Codebase.Causal qualified
+import U.Codebase.HashTags (CausalHash)
 import U.Codebase.Sqlite.DbId
 import U.Codebase.Sqlite.Project qualified as Sqlite
 import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
@@ -56,6 +68,7 @@ import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli
 import Unison.Cli.Share.Projects (IncludeSquashedHead)
 import Unison.Cli.Share.Projects qualified as Share
+import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Editor.Input (LooseCodeOrProject)
 import Unison.Codebase.Editor.Output (Output (LocalProjectBranchDoesntExist))
 import Unison.Codebase.Editor.Output qualified as Output
@@ -104,6 +117,18 @@ resolveBranchRelativePath = \case
       Left branchName -> That branchName
       Right (projectName, branchName) -> These projectName branchName
 
+justTheIds :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> ProjectAndBranch ProjectId ProjectBranchId
+justTheIds x =
+  ProjectAndBranch x.project.projectId x.branch.branchId
+
+justTheIds' :: Sqlite.ProjectBranch -> ProjectAndBranch ProjectId ProjectBranchId
+justTheIds' x =
+  ProjectAndBranch x.projectId x.branchId
+
+justTheNames :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> ProjectAndBranch ProjectName ProjectBranchName
+justTheNames x =
+  ProjectAndBranch x.project.name x.branch.name
+
 -- @findTemporaryBranchName projectId preferred@ finds some unused branch name in @projectId@ with a name
 -- like @preferred@.
 findTemporaryBranchName :: ProjectId -> ProjectBranchName -> Transaction ProjectBranchName
@@ -264,6 +289,13 @@ expectLooseCodeOrProjectBranch =
       That (ProjectAndBranch (Just project) branch) -> Right (These project branch)
       These path _ -> Left path -- (3) above
 
+-- | Get the causal hash of a project branch.
+getProjectBranchCausalHash :: ProjectAndBranch ProjectId ProjectBranchId -> Transaction CausalHash
+getProjectBranchCausalHash branch = do
+  let path = projectBranchPath branch
+  causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path)
+  pure causal.causalHash
+
 ------------------------------------------------------------------------------------------------------------------------
 -- Remote project utils
 
@@ -374,3 +406,14 @@ expectLatestReleaseBranchName remoteProject =
   case remoteProject.latestRelease of
     Nothing -> Cli.returnEarly (Output.ProjectHasNoReleases remoteProject.projectName)
     Just semver -> pure (UnsafeProjectBranchName ("releases/" <> into @Text semver))
+
+-- | @getUpgradeBranchParent branch@ returns the parent branch of an "upgrade" branch.
+--
+-- When an upgrade fails, we put you on a branch called `upgrade-<old>-to-<new>`. That's an "upgrade" branch. It's not
+-- currently distinguished in the database, so we first just switch on whether its name begins with "upgrade-". If it
+-- does, then we get the branch's parent, which should exist, but perhaps wouldn't if the user had manually made a
+-- parentless branch called "upgrade-whatever" for whatever reason.
+getUpgradeBranchParent :: Sqlite.ProjectBranch -> Maybe ProjectBranchId
+getUpgradeBranchParent branch = do
+  guard ("upgrade-" `Text.isPrefixOf` into @Text branch.name)
+  branch.parentBranchId

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

@@ -1,7 +1,6 @@
 -- | @.unisonConfig@ file utilities
 module Unison.Cli.UnisonConfigUtils
-  ( gitUrlKey,
-    remoteMappingKey,
+  ( remoteMappingKey,
     resolveConfiguredUrl,
   )
 where
@@ -33,9 +32,6 @@ configKey k p =
         NameSegment.toEscapedText
         (Path.toSeq $ Path.unabsolute p)
 
-gitUrlKey :: Path.Absolute -> Text
-gitUrlKey = configKey "GitUrl"
-
 remoteMappingKey :: Path.Absolute -> Text
 remoteMappingKey = configKey "RemoteMapping"
 
@@ -46,13 +42,7 @@ resolveConfiguredUrl :: PushPull -> Path' -> Cli (WriteRemoteNamespace Void)
 resolveConfiguredUrl pushPull destPath' = do
   destPath <- Cli.resolvePath' destPath'
   whenNothingM (remoteMappingForPath pushPull destPath) do
-    let gitUrlConfigKey = gitUrlKey destPath
-    -- Fall back to deprecated GitUrl key
-    Cli.getConfig gitUrlConfigKey >>= \case
-      Just url ->
-        (WriteRemoteNamespaceGit <$> P.parse UriParser.deprecatedWriteGitRemoteNamespace (Text.unpack gitUrlConfigKey) url) & onLeft \err ->
-          Cli.returnEarly (ConfiguredRemoteMappingParseError pushPull destPath url (show err))
-      Nothing -> Cli.returnEarly (NoConfiguredRemoteMapping pushPull destPath)
+    Cli.returnEarly (NoConfiguredRemoteMapping pushPull destPath)
 
 -- | Tries to look up a remote mapping for a given path.
 -- Will also resolve paths relative to any mapping which is configured for a parent of that

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

@@ -5,6 +5,7 @@ module Unison.Codebase.Editor.HandleInput (loop) where
 
 -- TODO: Don't import backend
 
+import Control.Arrow ((&&&))
 import Control.Error.Util qualified as ErrorUtil
 import Control.Lens hiding (from)
 import Control.Monad.Reader (ask)
@@ -27,7 +28,6 @@ import Text.Megaparsec qualified as Megaparsec
 import U.Codebase.Branch.Diff qualified as V2Branch.Diff
 import U.Codebase.Causal qualified as V2Causal
 import U.Codebase.HashTags (CausalHash (..))
-import U.Codebase.Reference qualified as V2 (Reference)
 import U.Codebase.Reflog qualified as Reflog
 import U.Codebase.Sqlite.Project qualified as Sqlite
 import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
@@ -57,6 +57,7 @@ import Unison.Codebase.Editor.HandleInput.AuthLogin (authLogin)
 import Unison.Codebase.Editor.HandleInput.Branch (handleBranch)
 import Unison.Codebase.Editor.HandleInput.BranchRename (handleBranchRename)
 import Unison.Codebase.Editor.HandleInput.Branches (handleBranches)
+import Unison.Codebase.Editor.HandleInput.CommitUpgrade (handleCommitUpgrade)
 import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition
 import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges
 import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch)
@@ -78,8 +79,8 @@ import Unison.Codebase.Editor.HandleInput.ProjectCreate (projectCreate)
 import Unison.Codebase.Editor.HandleInput.ProjectRename (handleProjectRename)
 import Unison.Codebase.Editor.HandleInput.ProjectSwitch (projectSwitch)
 import Unison.Codebase.Editor.HandleInput.Projects (handleProjects)
-import Unison.Codebase.Editor.HandleInput.Pull (handlePull, mergeBranchAndPropagateDefaultPatch, propagatePatch)
-import Unison.Codebase.Editor.HandleInput.Push (handleGist, handlePushRemoteBranch)
+import Unison.Codebase.Editor.HandleInput.Pull (handlePull, mergeBranchAndPropagateDefaultPatch)
+import Unison.Codebase.Editor.HandleInput.Push (handlePushRemoteBranch)
 import Unison.Codebase.Editor.HandleInput.ReleaseDraft (handleReleaseDraft)
 import Unison.Codebase.Editor.HandleInput.Run (handleRun)
 import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
@@ -98,6 +99,7 @@ import Unison.Codebase.Editor.Output.DumpNamespace qualified as Output.DN
 import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
 import Unison.Codebase.Editor.Slurp qualified as Slurp
 import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult
+import Unison.Codebase.Editor.StructuredArgument qualified as SA
 import Unison.Codebase.Editor.TodoOutput qualified as TO
 import Unison.Codebase.IntegrityCheck qualified as IntegrityCheck (integrityCheckFullCodebase)
 import Unison.Codebase.Metadata qualified as Metadata
@@ -106,15 +108,8 @@ import Unison.Codebase.Patch qualified as Patch
 import Unison.Codebase.Path (Path, Path' (..))
 import Unison.Codebase.Path qualified as HQSplit'
 import Unison.Codebase.Path qualified as Path
-import Unison.Codebase.Path.Parse qualified as Path
 import Unison.Codebase.Runtime qualified as Runtime
 import Unison.Codebase.ShortCausalHash qualified as SCH
-import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions
-import Unison.Codebase.TermEdit (TermEdit (..))
-import Unison.Codebase.TermEdit qualified as TermEdit
-import Unison.Codebase.TermEdit.Typing qualified as TermEdit
-import Unison.Codebase.TypeEdit (TypeEdit)
-import Unison.Codebase.TypeEdit qualified as TypeEdit
 import Unison.CommandLine.BranchRelativePath (BranchRelativePath)
 import Unison.CommandLine.Completion qualified as Completion
 import Unison.CommandLine.DisplayValues qualified as DisplayValues
@@ -132,7 +127,6 @@ import Unison.LabeledDependency qualified as LD
 import Unison.LabeledDependency qualified as LabeledDependency
 import Unison.Name (Name)
 import Unison.Name qualified as Name
-import Unison.NameSegment (NameSegment)
 import Unison.NameSegment qualified as NameSegment
 import Unison.Names (Names (Names))
 import Unison.Names qualified as Names
@@ -148,18 +142,16 @@ import Unison.PrettyPrintEnvDecl qualified as PPED
 import Unison.PrettyPrintEnvDecl.Names qualified as PPED
 import Unison.Project (ProjectAndBranch (..))
 import Unison.Project.Util (projectContextFromPath)
-import Unison.Reference (Reference, TermReference)
+import Unison.Reference (Reference)
 import Unison.Reference qualified as Reference
 import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent
 import Unison.Runtime.IOSource qualified as IOSource
-import Unison.Server.Backend (ShallowListEntry (..))
 import Unison.Server.Backend qualified as Backend
 import Unison.Server.CodebaseServer qualified as Server
 import Unison.Server.Doc.Markdown.Render qualified as Md
 import Unison.Server.Doc.Markdown.Types qualified as Md
 import Unison.Server.NameSearch.FromNames qualified as NameSearch
-import Unison.Server.QueryResult
 import Unison.Server.SearchResult (SearchResult)
 import Unison.Server.SearchResult qualified as SR
 import Unison.Share.Codeserver qualified as Codeserver
@@ -201,73 +193,13 @@ import UnliftIO.Directory qualified as Directory
 loop :: Either Event Input -> Cli ()
 loop e = do
   case e of
-    Left (IncomingRootBranch hashes) -> Cli.time "IncomingRootBranch" do
-      schLength <- Cli.runTransaction Codebase.branchHashLength
-      rootBranch <- Cli.getRootBranch
-      Cli.respond $
-        WarnIncomingRootBranch
-          (SCH.fromHash schLength $ Branch.headHash rootBranch)
-          (Set.map (SCH.fromHash schLength) hashes)
     Left (UnisonFileChanged sourceName text) -> Cli.time "UnisonFileChanged" do
       -- We skip this update if it was programmatically generated
       Cli.getLatestFile >>= \case
         Just (_, True) -> (#latestFile . _Just . _2) .= False
         _ -> loadUnisonFile sourceName text
     Right input ->
-      let typeReferences :: [SearchResult] -> [Reference]
-          typeReferences rs =
-            [r | SR.Tp (SR.TypeResult _ r _) <- rs]
-          termReferences :: [SearchResult] -> [Reference]
-          termReferences rs =
-            [r | SR.Tm (SR.TermResult _ (Referent.Ref r) _) <- rs]
-          termResults rs = [r | SR.Tm r <- rs]
-          typeResults rs = [r | SR.Tp r <- rs]
-          doRemoveReplacement :: HQ.HashQualified Name -> Maybe PatchPath -> Bool -> Cli ()
-          doRemoveReplacement from patchPath isTerm = do
-            let patchPath' = fromMaybe Cli.defaultPatchPath patchPath
-            patch <- Cli.getPatchAt patchPath'
-            QueryResult misses allHits <- hqNameQuery Names.IncludeSuffixes [from]
-            let tpRefs = Set.fromList $ typeReferences allHits
-                tmRefs = Set.fromList $ termReferences allHits
-                (hits, opHits) =
-                  let tmResults = Set.fromList $ SR.termName <$> termResults allHits
-                      tpResults = Set.fromList $ SR.typeName <$> typeResults allHits
-                   in case isTerm of
-                        True -> (tmResults, tpResults)
-                        False -> (tpResults, tmResults)
-                go :: Text -> Reference -> Cli ()
-                go description fr = do
-                  let termPatch = over Patch.termEdits (R.deleteDom fr) patch
-                      typePatch = over Patch.typeEdits (R.deleteDom fr) patch
-                  (patchPath'', patchName) <- Cli.resolveSplit' patchPath'
-                  -- Save the modified patch
-                  Cli.stepAtM
-                    description
-                    ( Path.unabsolute patchPath'',
-                      Branch.modifyPatches
-                        patchName
-                        (const (if isTerm then termPatch else typePatch))
-                    )
-                  -- Say something
-                  Cli.respond Success
-            when (Set.null hits) do
-              Cli.respond (SearchTermsNotFoundDetailed isTerm misses (Set.toList opHits))
-            description <- inputDescription input
-            traverse_ (go description) (if isTerm then tmRefs else tpRefs)
-          saveAndApplyPatch :: Path -> NameSegment -> Patch -> Cli ()
-          saveAndApplyPatch patchPath'' patchName patch' = do
-            description <- inputDescription input
-            Cli.stepAtM
-              (description <> " (1/2)")
-              ( patchPath'',
-                Branch.modifyPatches patchName (const patch')
-              )
-            -- Apply the modified patch to the current path
-            -- since we might be able to propagate further.
-            currentPath <- Cli.getCurrentPath
-            void $ propagatePatch description patch' currentPath
-            Cli.respond Success
-          previewResponse sourceName sr uf = do
+      let previewResponse sourceName sr uf = do
             names <- Cli.currentNames
             let namesWithDefinitionsFromFile = UF.addNamesFromTypeCheckedUnisonFile uf names
             filePPED <- Cli.prettyPrintEnvDeclFromNames namesWithDefinitionsFromFile
@@ -290,19 +222,22 @@ loop e = do
               Cli.respond $ PrintMessage pretty
             ShowReflogI -> do
               let numEntriesToShow = 500
-              entries <-
-                Cli.runTransaction do
-                  schLength <- Codebase.branchHashLength
-                  Codebase.getReflog numEntriesToShow <&> fmap (first $ SCH.fromHash schLength)
+              (schLength, entries) <-
+                Cli.runTransaction $
+                  (,) <$> Codebase.branchHashLength <*> Codebase.getReflog numEntriesToShow
               let moreEntriesToLoad = length entries == numEntriesToShow
               let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad)
-              let numberedEntries = expandedEntries <&> \(_time, hash, _reason) -> "#" <> SCH.toString hash
+              let (shortEntries, numberedEntries) =
+                    unzip $
+                      expandedEntries <&> \(time, hash, reason) ->
+                        let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash
+                         in ((time, exp, reason), sa)
               Cli.setNumberedArgs numberedEntries
-              Cli.respond $ ShowReflog expandedEntries
+              Cli.respond $ ShowReflog shortEntries
               where
                 expandEntries ::
-                  ([Reflog.Entry SCH.ShortCausalHash Text], Maybe SCH.ShortCausalHash, Bool) ->
-                  Maybe ((Maybe UTCTime, SCH.ShortCausalHash, Text), ([Reflog.Entry SCH.ShortCausalHash Text], Maybe SCH.ShortCausalHash, Bool))
+                  ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) ->
+                  Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool))
                 expandEntries ([], Just expectedHash, moreEntriesToLoad) =
                   if moreEntriesToLoad
                     then Nothing
@@ -435,8 +370,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
@@ -467,27 +405,6 @@ loop e = do
               hasConfirmed <- confirmedCommand input
               description <- inputDescription input
               doMoveBranch description hasConfirmed src' dest'
-            MovePatchI src' dest' -> do
-              description <- inputDescription input
-              p <- Cli.expectPatchAt src'
-              Cli.assertNoPatchAt dest'
-              src <- Cli.resolveSplit' src'
-              dest <- Cli.resolveSplit' dest'
-              Cli.stepManyAt
-                description
-                [ BranchUtil.makeDeletePatch (Path.convert src),
-                  BranchUtil.makeReplacePatch (Path.convert dest) p
-                ]
-              Cli.respond Success
-            CopyPatchI src dest' -> do
-              description <- inputDescription input
-              p <- Cli.expectPatchAt src
-              Cli.assertNoPatchAt dest'
-              dest <- Cli.resolveSplit' dest'
-              Cli.stepAt
-                description
-                (BranchUtil.makeReplacePatch (Path.convert dest) p)
-              Cli.respond Success
             SwitchBranchI path' -> do
               path <- Cli.resolvePath' path'
               branchExists <- Cli.branchExistsAtPath' path'
@@ -539,11 +456,12 @@ loop e = do
             DocToMarkdownI docName -> do
               names <- Cli.currentNames
               pped <- Cli.prettyPrintEnvDeclFromNames names
-              hqLength <- Cli.runTransaction Codebase.hashLength
-              let nameSearch = NameSearch.makeNameSearch hqLength names
               Cli.Env {codebase, runtime} <- ask
+              docRefs <- Cli.runTransaction do
+                hqLength <- Codebase.hashLength
+                let nameSearch = NameSearch.makeNameSearch hqLength names
+                Backend.docsForDefinitionName codebase nameSearch Names.IncludeSuffixes docName
               mdText <- liftIO $ do
-                docRefs <- Backend.docsForDefinitionName codebase nameSearch Names.IncludeSuffixes docName
                 for docRefs \docRef -> do
                   Identity (_, _, doc, _evalErrs) <- Backend.renderDocRefs pped (Pretty.Width 80) codebase runtime (Identity docRef)
                   pure . Md.toText $ Md.toMarkdown doc
@@ -730,14 +648,6 @@ loop e = do
               DeleteTarget'TermOrType doutput hqs -> delete input doutput Cli.getTermsAt Cli.getTypesAt hqs
               DeleteTarget'Type doutput hqs -> delete input doutput (const (pure Set.empty)) Cli.getTypesAt hqs
               DeleteTarget'Term doutput hqs -> delete input doutput Cli.getTermsAt (const (pure Set.empty)) hqs
-              DeleteTarget'Patch src' -> do
-                _ <- Cli.expectPatchAt src'
-                description <- inputDescription input
-                src <- Cli.resolveSplit' src'
-                Cli.stepAt
-                  description
-                  (BranchUtil.makeDeletePatch (Path.convert src))
-                Cli.respond Success
               DeleteTarget'Namespace insistence Nothing -> do
                 hasConfirmed <- confirmedCommand input
                 if hasConfirmed || insistence == Force
@@ -747,16 +657,15 @@ loop e = do
                     Cli.respond DeletedEverything
                   else Cli.respond DeleteEverythingConfirmation
               DeleteTarget'Namespace insistence (Just p@(parentPath, childName)) -> do
-                branch <- Cli.expectBranchAtPath' (Path.unsplit' p)
+                branch <- Cli.expectBranchAtPath (Path.unsplit p)
                 description <- inputDescription input
-                absPath <- Cli.resolveSplit' p
                 let toDelete =
                       Names.prefix0
-                        (Path.unsafeToName (Path.unsplit (Path.convert absPath)))
+                        (Path.unsafeToName (Path.unsplit (p)))
                         (Branch.toNames (Branch.head branch))
                 afterDelete <- do
-                  rootNames <- Branch.toNames <$> Cli.getRootBranch0
-                  endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty rootNames)
+                  names <- Cli.currentNames
+                  endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty names)
                   case (null endangerments, insistence) of
                     (True, _) -> pure (Cli.respond Success)
                     (False, Force) -> do
@@ -768,7 +677,7 @@ loop e = do
                       ppeDecl <- Cli.currentPrettyPrintEnvDecl
                       Cli.respondNumbered $ CantDeleteNamespace ppeDecl endangerments
                       Cli.returnEarlyWithoutOutput
-                parentPathAbs <- Cli.resolvePath' parentPath
+                parentPathAbs <- Cli.resolvePath parentPath
                 -- We have to modify the parent in order to also wipe out the history at the
                 -- child.
                 Cli.updateAt description parentPathAbs \parentBranch ->
@@ -781,21 +690,12 @@ loop e = do
               traverse_ (displayI outputLoc) namesToDisplay
             ShowDefinitionI outputLoc showDefinitionScope query -> handleShowDefinition outputLoc showDefinitionScope query
             EditNamespaceI paths -> handleEditNamespace LatestFileLocation paths
-            FindPatchI -> do
-              branch <- Cli.getCurrentBranch0
-              let patches =
-                    [ Path.unsafeToName $ Path.snoc p seg
-                      | (p, b) <- Branch.toList0 branch,
-                        (seg, _) <- Map.toList (Branch._edits b)
-                    ]
-              Cli.respond $ ListOfPatches $ Set.fromList patches
-              Cli.setNumberedArgs $ fmap (Text.unpack . Name.toText) patches
             FindShallowI pathArg -> do
               Cli.Env {codebase} <- ask
 
               pathArgAbs <- Cli.resolvePath' pathArg
               entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs)
-              Cli.setNumberedArgs $ fmap entryToHQString entries
+              Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries
               pped <- Cli.currentPrettyPrintEnvDecl
               let suffixifiedPPE = PPED.suffixifiedPPE pped
               -- This used to be a delayed action which only forced the loading of the root
@@ -805,115 +705,9 @@ loop e = do
               -- in an improvement, so perhaps it's not worth the effort.
               let buildPPE = pure suffixifiedPPE
               Cli.respond $ ListShallow buildPPE entries
-              where
-                entryToHQString :: ShallowListEntry v Ann -> String
-                entryToHQString e =
-                  fixup $ Text.unpack case e of
-                    ShallowTypeEntry te -> Backend.typeEntryDisplayName te
-                    ShallowTermEntry te -> Backend.termEntryDisplayName te
-                    ShallowBranchEntry ns _ _ -> NameSegment.toEscapedText ns
-                    ShallowPatchEntry ns -> NameSegment.toEscapedText ns
-                  where
-                    fixup s = case pathArgStr of
-                      "" -> s
-                      p | last p == '.' -> p ++ s
-                      p -> p ++ "." ++ s
-                    pathArgStr = show pathArg
             FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input
             StructuredFindI _fscope ws -> handleStructuredFindI ws
             StructuredFindReplaceI ws -> handleStructuredFindReplaceI ws
-            ReplaceI from to patchPath -> do
-              Cli.Env {codebase} <- ask
-              hqLength <- Cli.runTransaction Codebase.hashLength
-
-              let patchPath' = fromMaybe Cli.defaultPatchPath patchPath
-              patch <- Cli.getPatchAt patchPath'
-              QueryResult fromMisses' fromHits <- hqNameQuery Names.IncludeSuffixes [from]
-              QueryResult toMisses' toHits <- hqNameQuery Names.IncludeSuffixes [to]
-              let termsFromRefs = termReferences fromHits
-                  termsToRefs = termReferences toHits
-                  typesFromRefs = typeReferences fromHits
-                  typesToRefs = typeReferences toHits
-                  --- Here are all the kinds of misses
-                  --- [X] [X]
-                  --- [Type] [Term]
-                  --- [Term] [Type]
-                  --- [Type] [X]
-                  --- [Term] [X]
-                  --- [X] [Type]
-                  --- [X] [Term]
-                  -- Type hits are term misses
-                  termFromMisses = fromMisses' <> (SR.typeName <$> typeResults fromHits)
-                  termToMisses = toMisses' <> (SR.typeName <$> typeResults toHits)
-                  -- Term hits are type misses
-                  typeFromMisses = fromMisses' <> (SR.termName <$> termResults fromHits)
-                  typeToMisses = toMisses' <> (SR.termName <$> termResults toHits)
-
-                  termMisses = termFromMisses <> termToMisses
-                  typeMisses = typeFromMisses <> typeToMisses
-
-                  replaceTerms :: Reference -> Reference -> Cli ()
-                  replaceTerms fr tr = do
-                    (mft, mtt) <-
-                      Cli.runTransaction do
-                        mft <- Codebase.getTypeOfTerm codebase fr
-                        mtt <- Codebase.getTypeOfTerm codebase tr
-                        pure (mft, mtt)
-                    let termNotFound =
-                          Cli.returnEarly
-                            . TermNotFound'
-                            . SH.shortenTo hqLength
-                            . Reference.toShortHash
-                    ft <- mft & onNothing (termNotFound fr)
-                    tt <- mtt & onNothing (termNotFound tr)
-                    let patch' =
-                          -- The modified patch
-                          over
-                            Patch.termEdits
-                            ( R.insert fr (Replace tr (TermEdit.typing tt ft))
-                                . R.deleteDom fr
-                            )
-                            patch
-                    (patchPath'', patchName) <- Cli.resolveSplit' patchPath'
-                    saveAndApplyPatch (Path.convert patchPath'') patchName patch'
-
-                  replaceTypes :: Reference -> Reference -> Cli ()
-                  replaceTypes fr tr = do
-                    let patch' =
-                          -- The modified patch
-                          over
-                            Patch.typeEdits
-                            (R.insert fr (TypeEdit.Replace tr) . R.deleteDom fr)
-                            patch
-                    (patchPath'', patchName) <- Cli.resolveSplit' patchPath'
-                    saveAndApplyPatch (Path.convert patchPath'') patchName patch'
-
-                  ambiguous :: HQ.HashQualified Name -> [TermReference] -> Cli a
-                  ambiguous t rs =
-                    Cli.returnEarly case t of
-                      HQ.HashOnly h -> HashAmbiguous h rs'
-                      (Path.parseHQSplit' . Text.unpack . HQ.toText -> Right n) -> DeleteNameAmbiguous hqLength n rs' Set.empty
-                      _ -> BadName (HQ.toText t)
-                    where
-                      rs' = Set.map Referent.Ref $ Set.fromList rs
-
-                  mismatch typeName termName = Cli.respond $ TypeTermMismatch typeName termName
-
-              case (termsFromRefs, termsToRefs, typesFromRefs, typesToRefs) of
-                ([], [], [], []) -> Cli.respond $ SearchTermsNotFound termMisses
-                ([_], [], [], [_]) -> mismatch to from
-                ([], [_], [_], []) -> mismatch from to
-                ([_], [], _, _) -> Cli.respond $ SearchTermsNotFound termMisses
-                ([], [_], _, _) -> Cli.respond $ SearchTermsNotFound termMisses
-                (_, _, [_], []) -> Cli.respond $ SearchTermsNotFound typeMisses
-                (_, _, [], [_]) -> Cli.respond $ SearchTermsNotFound typeMisses
-                ([fr], [tr], [], []) -> replaceTerms fr tr
-                ([], [], [fr], [tr]) -> replaceTypes fr tr
-                (froms, [_], [], []) -> ambiguous from froms
-                ([], [], froms, [_]) -> ambiguous from froms
-                ([_], tos, [], []) -> ambiguous to tos
-                ([], [], [_], tos) -> ambiguous to tos
-                (_, _, _, _) -> error "unpossible"
             LoadI maybePath -> handleLoad maybePath
             ClearI -> Cli.respond ClearScreen
             AddI requestedNames -> do
@@ -953,12 +747,6 @@ loop e = do
               branchPath <- Cli.resolvePath' branchPath'
               doShowTodoOutput patch branchPath
             TestI testInput -> Tests.handleTest testInput
-            PropagatePatchI patchPath scopePath' -> do
-              description <- inputDescription input
-              patch <- Cli.getPatchAt patchPath
-              scopePath <- Cli.resolvePath' scopePath'
-              updated <- propagatePatch description patch scopePath
-              when (not updated) (Cli.respond $ NothingToPatch patchPath scopePath')
             ExecuteI main args -> handleRun False main args
             MakeStandaloneI output main -> doCompile False output main
             CompileSchemeI output main ->
@@ -1019,19 +807,15 @@ loop e = do
               _ <- Cli.updateAtM description destPath \destb ->
                 liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb)
               Cli.respond Success
-            ListEditsI maybePath -> do
-              patch <- Cli.getPatchAt (fromMaybe Cli.defaultPatchPath maybePath)
-              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
             NamespaceDependenciesI path -> handleNamespaceDependencies path
             DebugNumberedArgsI -> do
+              schLength <- Cli.runTransaction Codebase.branchHashLength
               numArgs <- use #numberedArgs
-              Cli.respond (DumpNumberedArgs numArgs)
+              Cli.respond (DumpNumberedArgs schLength numArgs)
             DebugTypecheckedUnisonFileI -> do
               hqLength <- Cli.runTransaction Codebase.hashLength
               uf <- Cli.expectLatestTypecheckedFile
@@ -1164,21 +948,12 @@ loop e = do
                   nameChanges <- V2Branch.Diff.allNameChanges Nothing treeDiff
                   pure (DisplayDebugNameDiff nameChanges)
               Cli.respond output
-            DeprecateTermI {} -> Cli.respond NotImplemented
-            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
             AuthLoginI -> void $ authLogin (Codeserver.resolveCodeserver RemoteRepo.DefaultCodeserver)
             VersionI -> do
               Cli.Env {ucmVersion} <- ask
               Cli.respond $ PrintVersion ucmVersion
-            DiffNamespaceToPatchI diffNamespaceToPatchInput -> do
-              description <- inputDescription input
-              handleDiffNamespaceToPatch description diffNamespaceToPatchInput
             ProjectRenameI name -> handleProjectRename name
             ProjectSwitchI name -> projectSwitch name
             ProjectCreateI tryDownloadingBase name -> projectCreate tryDownloadingBase name
@@ -1189,6 +964,7 @@ loop e = do
             CloneI remoteNames localNames -> handleClone remoteNames localNames
             ReleaseDraftI semver -> handleReleaseDraft semver
             UpgradeI old new -> handleUpgrade old new
+            UpgradeCommitI -> handleCommitUpgrade
             LibInstallI libdep -> handleInstallLib libdep
 
 inputDescription :: Input -> Cli Text
@@ -1249,14 +1025,6 @@ inputDescription input =
       src <- p' src0
       dest <- p' dest0
       pure ("move " <> src <> " " <> dest)
-    MovePatchI src0 dest0 -> do
-      src <- ps' src0
-      dest <- ps' dest0
-      pure ("move.patch " <> src <> " " <> dest)
-    CopyPatchI src0 dest0 -> do
-      src <- ps' src0
-      dest <- ps' dest0
-      pure ("copy.patch " <> src <> " " <> dest)
     DeleteI dtarget -> do
       case dtarget of
         DeleteTarget'TermOrType DeleteOutput'NoDiff things0 -> do
@@ -1278,25 +1046,13 @@ inputDescription input =
           thing <- traverse hqs' thing0
           pure ("delete.type.verbose " <> Text.intercalate " " thing)
         DeleteTarget'Namespace Try opath0 -> do
-          opath <- ops' opath0
+          opath <- ops opath0
           pure ("delete.namespace " <> opath)
         DeleteTarget'Namespace Force opath0 -> do
-          opath <- ops' opath0
+          opath <- ops opath0
           pure ("delete.namespace.force " <> opath)
-        DeleteTarget'Patch path0 -> do
-          path <- ps' path0
-          pure ("delete.patch " <> path)
         DeleteTarget'ProjectBranch _ -> wat
         DeleteTarget'Project _ -> wat
-    ReplaceI src target p0 -> do
-      p <- opatch p0
-      pure $
-        "replace "
-          <> HQ.toText src
-          <> " "
-          <> HQ.toText target
-          <> " "
-          <> p
     AddI _selection -> pure "add"
     UpdateI p0 _selection -> do
       p <-
@@ -1306,12 +1062,8 @@ inputDescription input =
           UsePatch p0 -> (" " <>) <$> ps' p0
       pure ("update.old" <> p)
     Update2I -> pure ("update")
-    PropagatePatchI p0 scope0 -> do
-      p <- ps' p0
-      scope <- p' scope0
-      pure ("patch " <> p <> " " <> scope)
     UndoI {} -> pure "undo"
-    ExecuteI s args -> pure ("execute " <> Text.unwords (s : fmap Text.pack args))
+    ExecuteI s args -> pure ("execute " <> Text.unwords (HQ.toText s : fmap Text.pack args))
     IOTestI hq -> pure ("io.test " <> HQ.toText hq)
     IOTestAllI -> pure "io.test.all"
     UpdateBuiltinsI -> pure "builtins.update"
@@ -1321,20 +1073,9 @@ inputDescription input =
     MergeIOBuiltinsI (Just path) -> ("builtins.mergeio " <>) <$> p path
     MakeStandaloneI out nm -> pure ("compile " <> Text.pack out <> " " <> HQ.toText nm)
     ExecuteSchemeI nm args ->
-      pure $ "run.native " <> Text.unwords (nm : fmap Text.pack args)
+      pure $ "run.native " <> Text.unwords (HQ.toText nm : fmap Text.pack args)
     CompileSchemeI fi nm -> pure ("compile.native " <> HQ.toText nm <> " " <> fi)
     CreateAuthorI id name -> pure ("create.author " <> NameSegment.toEscapedText id <> " " <> name)
-    RemoveTermReplacementI src p0 -> do
-      p <- opatch p0
-      pure ("delete.term-replacement" <> HQ.toText src <> " " <> p)
-    RemoveTypeReplacementI src p0 -> do
-      p <- opatch p0
-      pure ("delete.type-replacement" <> HQ.toText src <> " " <> p)
-    DiffNamespaceToPatchI input -> do
-      branchId1 <- hp' (input ^. #branchId1)
-      branchId2 <- hp' (input ^. #branchId2)
-      patch <- ps' (input ^. #patch)
-      pure (Text.unwords ["diff.namespace.to-patch", branchId1, branchId2, patch])
     ClearI {} -> pure "clear"
     DocToMarkdownI name -> pure ("debug.doc-to-markdown " <> Name.toText name)
     --
@@ -1361,23 +1102,18 @@ inputDescription input =
     DebugFuzzyOptionsI cmd input -> pure . Text.pack $ "debug.fuzzy-completions " <> unwords (cmd : toList input)
     DebugFormatI -> pure "debug.format"
     DebugTypecheckedUnisonFileI {} -> wat
-    DeprecateTermI {} -> wat
-    DeprecateTypeI {} -> wat
     DiffNamespaceI {} -> wat
     DisplayI {} -> wat
     DocsI {} -> wat
     DocsToHtmlI {} -> wat
     FindI {} -> wat
-    FindPatchI {} -> wat
     FindShallowI {} -> wat
     StructuredFindI {} -> wat
     StructuredFindReplaceI {} -> wat
-    GistI {} -> wat
     HistoryI {} -> wat
     LibInstallI {} -> wat
     ListDependenciesI {} -> wat
     ListDependentsI {} -> wat
-    ListEditsI {} -> wat
     LoadI {} -> wat
     MergeI {} -> wat
     NamesI {} -> wat
@@ -1390,11 +1126,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))
@@ -1405,6 +1140,7 @@ inputDescription input =
     UiI {} -> wat
     UpI {} -> wat
     UpgradeI {} -> wat
+    UpgradeCommitI {} -> wat
     VersionI -> wat
   where
     hp' :: Either SCH.ShortCausalHash Path' -> Cli Text
@@ -1415,10 +1151,8 @@ inputDescription input =
     p' = fmap tShow . Cli.resolvePath'
     brp :: BranchRelativePath -> Cli Text
     brp = fmap from . ProjectUtils.resolveBranchRelativePath
-    ops' :: Maybe Path.Split' -> Cli Text
-    ops' = maybe (pure ".") ps'
-    opatch :: Maybe Path.Split' -> Cli Text
-    opatch = ps' . fromMaybe Cli.defaultPatchPath
+    ops :: Maybe Path.Split -> Cli Text
+    ops = maybe (pure ".") ps
     wat = error $ show input ++ " is not expected to alter the branch"
     hhqs' :: Either SH.ShortHash Path.HQSplit' -> Cli Text
     hhqs' = \case
@@ -1430,6 +1164,7 @@ inputDescription input =
       pure (p <> "." <> HQ'.toTextWith NameSegment.toEscapedText hq)
     hqs (p, hq) = hqs' (Path' . Right . Path.Relative $ p, hq)
     ps' = p' . Path.unsplit'
+    ps = p . Path.unsplit
     looseCodeOrProjectToText :: Input.LooseCodeOrProject -> Cli Text
     looseCodeOrProjectToText = \case
       This path -> p' path
@@ -1501,7 +1236,7 @@ handleFindI isVerbose fscope ws input = do
                     (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs)
             pure $ uniqueBy SR.toReferent srs
   let respondResults results = do
-        Cli.setNumberedArgs $ fmap (searchResultToHQString searchRoot) results
+        Cli.setNumberedArgs $ fmap (SA.SearchResult searchRoot) results
         results' <- Cli.runTransaction (Backend.loadSearchResults codebase results)
         Cli.respond $ ListOfDefinitions fscope suffixifiedPPE isVerbose results'
   results <- getResults names
@@ -1553,12 +1288,10 @@ handleDependencies hq = do
     let types = [(PPE.typeName suffixifiedPPE r, r) | LabeledDependency.TypeReference r <- toList dependencies]
     let terms = [(PPE.termName suffixifiedPPE r, r) | LabeledDependency.TermReferent r <- toList dependencies]
     pure (types, terms)
-  let types = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ fst <$> results)
-  let terms = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ snd <$> results)
-  Cli.setNumberedArgs $
-    map (Text.unpack . Reference.toText . snd) types
-      <> map (Text.unpack . Reference.toText . Referent.toReference . snd) terms
-  Cli.respond $ ListDependencies suffixifiedPPE lds (fst <$> types) (fst <$> terms)
+  let types = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) . join $ fst <$> results
+  let terms = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) . join $ snd <$> results
+  Cli.setNumberedArgs . map SA.HashQualified $ types <> terms
+  Cli.respond $ ListDependencies suffixifiedPPE lds types terms
 
 handleDependents :: HQ.HashQualified Name -> Cli ()
 handleDependents hq = do
@@ -1575,7 +1308,7 @@ handleDependents hq = do
   results <- for (toList lds) \ld -> do
     -- The full set of dependent references, any number of which may not have names in the current namespace.
     dependents <-
-      let tp r = Codebase.dependents Queries.ExcludeOwnComponent r
+      let tp = Codebase.dependents Queries.ExcludeOwnComponent
           tm = \case
             Referent.Ref r -> Codebase.dependents Queries.ExcludeOwnComponent r
             Referent.Con (ConstructorReference r _cid) _ct ->
@@ -1591,78 +1324,11 @@ handleDependents hq = do
           Just shortName <- pure $ PPE.terms ppe (Referent.Ref r) <|> PPE.types ppe r
           pure (isTerm, HQ'.toHQ shortName, r)
     pure results
-  let sort = nubOrdOn snd . Name.sortByText (HQ.toText . fst)
+  let sort = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst)
   let types = sort [(n, r) | (False, n, r) <- join results]
   let terms = sort [(n, r) | (True, n, r) <- join results]
-  Cli.setNumberedArgs $ map (Text.unpack . Reference.toText . view _2) (types <> terms)
-  Cli.respond (ListDependents ppe lds (fst <$> types) (fst <$> terms))
-
-handleDiffNamespaceToPatch :: Text -> DiffNamespaceToPatchInput -> Cli ()
-handleDiffNamespaceToPatch description input = do
-  Cli.Env {codebase} <- ask
-
-  absBranchId1 <- Cli.resolveBranchIdToAbsBranchId (input ^. #branchId1)
-  absBranchId2 <- Cli.resolveBranchIdToAbsBranchId (input ^. #branchId2)
-
-  patch <- do
-    Cli.runTransactionWithRollback \rollback -> do
-      branch1 <- Cli.resolveAbsBranchIdV2 rollback absBranchId1
-      branch2 <- Cli.resolveAbsBranchIdV2 rollback absBranchId2
-      branchDiff <- V2Branch.Diff.diffBranches branch1 branch2 >>= V2Branch.Diff.nameBasedDiff
-      termEdits <-
-        (branchDiff ^. #terms)
-          & Relation.domain
-          & Map.toList
-          & traverse \(oldRef, newRefs) -> makeTermEdit codebase oldRef newRefs
-      pure
-        Patch
-          { _termEdits =
-              termEdits
-                & catMaybes
-                & Relation.fromList,
-            _typeEdits =
-              (branchDiff ^. #types)
-                & Relation.domain
-                & Map.toList
-                & mapMaybe (\(oldRef, newRefs) -> makeTypeEdit oldRef newRefs)
-                & Relation.fromList
-          }
-
-  -- Display the patch that we are about to create.
-  suffixifiedPPE <- PPED.suffixifiedPPE <$> Cli.currentPrettyPrintEnvDecl
-  Cli.respondNumbered (ListEdits patch suffixifiedPPE)
-
-  (patchPath, patchName) <- Cli.resolveSplit' (input ^. #patch)
-
-  -- Add the patch to the in-memory root branch and flush it all to SQLite.
-  -- If there's already a patch at the given path, overwrite it.
-  Cli.stepAtM
-    description
-    (Path.unabsolute patchPath, Branch.modifyPatches patchName (const patch))
-  where
-    -- Given {old reference} and {new references}, create term edit patch entries as follows:
-    --
-    --   * If the {new references} is a singleton set {new reference}, proceed. (Otherwise, the patch we might create
-    --     would not be a function, which is a bogus/conflicted patch).
-    --   * Look up {old reference} and {new reference} types in the codebase (which can technically fail, due to
-    --     non-transactionality of this command, though we don't typically delete anything from SQLite), and create a
-    --     patch entry that maps {old reference} to {new reference} with the typing relationship.
-    makeTermEdit ::
-      Codebase m Symbol Ann ->
-      V2.Reference ->
-      Set V2.Reference ->
-      Sqlite.Transaction (Maybe (Reference, TermEdit))
-    makeTermEdit codebase (Conversions.reference2to1 -> oldRef) newRefs =
-      runMaybeT do
-        newRef <- Conversions.reference2to1 <$> MaybeT (pure (Set.asSingleton newRefs))
-        oldRefType <- MaybeT (Codebase.getTypeOfTerm codebase oldRef)
-        newRefType <- MaybeT (Codebase.getTypeOfTerm codebase newRef)
-        pure (oldRef, TermEdit.Replace newRef (TermEdit.typing oldRefType newRefType))
-
-    -- Same idea as 'makeTermEdit', but simpler, because there's nothing to look up in the database.
-    makeTypeEdit :: V2.Reference -> Set V2.Reference -> Maybe (Reference, TypeEdit)
-    makeTypeEdit (Conversions.reference2to1 -> oldRef) newRefs =
-      Set.asSingleton newRefs <&> \newRef -> (oldRef, TypeEdit.Replace (Conversions.reference2to1 newRef))
+  Cli.setNumberedArgs . map SA.HashQualified $ types <> terms
+  Cli.respond (ListDependents ppe lds types terms)
 
 -- | Handle a @ShowDefinitionI@ input command, i.e. `view` or `edit`.
 handleShowDefinition :: OutputLocation -> ShowDefinitionScope -> NonEmpty (HQ.HashQualified Name) -> Cli ()
@@ -1774,10 +1440,9 @@ doShowTodoOutput patch scopePath = do
   if TO.noConflicts todo && TO.noEdits todo
     then Cli.respond NoConflictsOrEdits
     else do
-      Cli.setNumberedArgs
-        ( Text.unpack . Reference.toText . view _2
-            <$> fst (TO.todoFrontierDependents todo)
-        )
+      Cli.setNumberedArgs $
+        SA.HashQualified . HQ.HashOnly . Reference.toShortHash . view _2
+          <$> fst (TO.todoFrontierDependents todo)
       pped <- Cli.currentPrettyPrintEnvDecl
       Cli.respondNumbered $ TodoOutput pped todo
 
@@ -1823,16 +1488,6 @@ confirmedCommand i = do
   loopState <- State.get
   pure $ Just i == (loopState ^. #lastInput)
 
--- | restores the full hash to these search results, for _numberedArgs purposes
-searchResultToHQString :: Maybe Path -> SearchResult -> String
-searchResultToHQString oprefix = \case
-  SR.Tm' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify (addPrefix <$> n) r
-  SR.Tp' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify (addPrefix <$> n) (Referent.Ref r)
-  _ -> error "impossible match failure"
-  where
-    addPrefix :: Name -> Name
-    addPrefix = maybe id Path.prefixName2 oprefix
-
 -- return `name` and `name.<everything>...`
 _searchBranchPrefix :: Branch m -> Name -> [SearchResult]
 _searchBranchPrefix b n = case Path.unsnoc (Path.fromName n) of
@@ -2105,7 +1760,7 @@ displayI outputLoc hq = do
       let ns = UF.addNamesFromTypeCheckedUnisonFile unisonFile names
       doDisplay outputLoc ns tm
 
-docsI :: Path.HQSplit' -> Cli ()
+docsI :: Name -> Cli ()
 docsI src = do
   findInScratchfileByName
   where
@@ -2113,14 +1768,8 @@ docsI src = do
        (fileByName) First check the file for `foo.doc`, and if found do `display foo.doc`
        (codebaseByName) Lastly check for `foo.doc` in the codebase and if found do `display foo.doc`
     -}
-    hq :: HQ.HashQualified Name
-    hq =
-      let hq' :: HQ'.HashQualified Name
-          hq' = Path.unsafeToName' <$> Name.convert src
-       in Name.convert hq'
-
     dotDoc :: HQ.HashQualified Name
-    dotDoc = hq <&> \n -> Name.joinDot n (Name.fromSegment NameSegment.docSegment)
+    dotDoc = Name.convert . Name.joinDot src $ Name.fromSegment NameSegment.docSegment
 
     findInScratchfileByName :: Cli ()
     findInScratchfileByName = do
@@ -2210,15 +1859,6 @@ addWatch watchName (Just uf) = do
             )
     _ -> addWatch watchName Nothing
 
-hqNameQuery :: Names.SearchType -> [HQ.HashQualified Name] -> Cli QueryResult
-hqNameQuery searchType query = do
-  Cli.Env {codebase} <- ask
-  names <- Cli.currentNames
-  Cli.runTransaction do
-    hqLength <- Codebase.hashLength
-    let nameSearch = NameSearch.makeNameSearch hqLength names
-    Backend.hqNameQuery codebase nameSearch searchType query
-
 looseCodeOrProjectToPath :: Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> Path'
 looseCodeOrProjectToPath = \case
   Left pth -> pth

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

@@ -120,11 +120,10 @@ doCreateBranch createFrom project newBranchName description = do
         Cli.getBranchAt (ProjectUtils.projectBranchPath (ProjectAndBranch sourceProjectId sourceBranchId))
       CreateFrom'LooseCode sourcePath -> Cli.getBranchAt sourcePath
       CreateFrom'Nothingness -> pure Branch.empty
-  let projectId = project ^. #projectId
   let parentBranchId =
         case createFrom of
           CreateFrom'Branch (ProjectAndBranch _ sourceBranch)
-            | (sourceBranch ^. #projectId) == projectId -> Just (sourceBranch ^. #branchId)
+            | sourceBranch.projectId == project.projectId -> Just sourceBranch.branchId
           _ -> Nothing
   doCreateBranch' sourceNamespaceObject parentBranchId project (pure newBranchName) description
 

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

@@ -0,0 +1,50 @@
+-- | @upgrade.commit@ handler.
+module Unison.Codebase.Editor.HandleInput.CommitUpgrade
+  ( handleCommitUpgrade,
+  )
+where
+
+import U.Codebase.Sqlite.Project qualified
+import U.Codebase.Sqlite.Queries qualified as Queries
+import Unison.Cli.Monad (Cli)
+import Unison.Cli.Monad qualified as Cli
+import Unison.Cli.ProjectUtils qualified as ProjectUtils
+import Unison.Codebase.Editor.HandleInput.DeleteBranch qualified as DeleteBranch
+import Unison.Codebase.Editor.HandleInput.Merge2 qualified as Merge
+import Unison.Codebase.Editor.HandleInput.ProjectSwitch qualified as ProjectSwitch
+import Unison.Codebase.Editor.Output qualified as Output
+import Unison.Merge.TwoWay (TwoWay (..))
+import Unison.Prelude
+import Unison.Project (ProjectAndBranch (..))
+
+handleCommitUpgrade :: Cli ()
+handleCommitUpgrade = do
+  (upgradeProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch
+
+  -- Assert that this is an "upgrade" branch and get its parent, which is the branch we were on when we ran `upgrade`.
+
+  parentBranchId <-
+    ProjectUtils.getUpgradeBranchParent upgradeProjectAndBranch.branch
+      & onNothing (Cli.returnEarly Output.NoUpgradeInProgress)
+  parentBranch <-
+    Cli.runTransaction do
+      Queries.expectProjectBranch upgradeProjectAndBranch.project.projectId parentBranchId
+
+  let parentProjectAndBranch =
+        ProjectAndBranch upgradeProjectAndBranch.project parentBranch
+
+  -- Switch to the parent
+
+  ProjectSwitch.switchToProjectBranch (ProjectUtils.justTheIds parentProjectAndBranch)
+
+  -- Merge the upgrade branch into the parent
+
+  Merge.doMergeLocalBranch
+    TwoWay
+      { alice = parentProjectAndBranch,
+        bob = upgradeProjectAndBranch
+      }
+
+  -- Delete the upgrade branch
+
+  DeleteBranch.doDeleteProjectBranch upgradeProjectAndBranch

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

@@ -1,19 +1,21 @@
 -- | @delete.branch@ input handler
 module Unison.Codebase.Editor.HandleInput.DeleteBranch
   ( handleDeleteBranch,
+    doDeleteProjectBranch,
   )
 where
 
-import Control.Lens (over, (^.))
+import Control.Lens (over)
 import Data.Map.Strict qualified as Map
 import Data.These (These (..))
+import U.Codebase.Sqlite.Project qualified as Sqlite
+import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
 import U.Codebase.Sqlite.Queries qualified as Queries
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli
 import Unison.Cli.ProjectUtils qualified as ProjectUtils
 import Unison.Codebase.Branch qualified as Branch
-import Unison.Codebase.Editor.Output qualified as Output
 import Unison.Codebase.Path qualified as Path
 import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
@@ -25,47 +27,45 @@ import Witch (unsafeFrom)
 -- Its children branches, if any, are reparented to their grandparent, if any. You may delete the only branch in a
 -- project.
 handleDeleteBranch :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
-handleDeleteBranch projectAndBranchNames0 = do
-  projectAndBranchNames <-
-    ProjectUtils.hydrateNames
-      case projectAndBranchNames0 of
+handleDeleteBranch projectAndBranchNamesToDelete = do
+  projectAndBranchToDelete <-
+    ProjectUtils.expectProjectAndBranchByTheseNames
+      case projectAndBranchNamesToDelete of
         ProjectAndBranch Nothing branch -> That branch
         ProjectAndBranch (Just project) branch -> These project branch
 
   maybeCurrentBranch <- ProjectUtils.getCurrentProjectBranch
 
-  deletedBranch <-
-    Cli.runTransactionWithRollback \rollback -> do
-      branch <-
-        Queries.loadProjectBranchByNames (projectAndBranchNames ^. #project) (projectAndBranchNames ^. #branch)
-          & onNothingM (rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames))
-      Queries.deleteProjectBranch (branch ^. #projectId) (branch ^. #branchId)
-      pure branch
-
-  let projectId = deletedBranch ^. #projectId
-
-  Cli.stepAt
-    ("delete.branch " <> into @Text projectAndBranchNames)
-    ( Path.unabsolute (ProjectUtils.projectBranchesPath projectId),
-      \branchObject ->
-        branchObject
-          & over
-            Branch.children
-            (Map.delete (ProjectUtils.projectBranchSegment (deletedBranch ^. #branchId)))
-    )
+  doDeleteProjectBranch projectAndBranchToDelete
 
   -- If the user is on the branch that they're deleting, we have to cd somewhere; try these in order:
   --
   --   1. cd to parent branch, if it exists
   --   2. cd to "main", if it exists
   --   3. cd to loose code path `.`
-  whenJust maybeCurrentBranch \(ProjectAndBranch _currentProject currentBranch, _restPath) ->
-    when (deletedBranch == currentBranch) do
+  whenJust maybeCurrentBranch \(currentProjectAndBranch, _restPath) ->
+    when (ProjectUtils.justTheIds currentProjectAndBranch == ProjectUtils.justTheIds projectAndBranchToDelete) do
       newPath <-
-        case deletedBranch ^. #parentBranchId of
+        case projectAndBranchToDelete.branch.parentBranchId of
           Nothing ->
-            Cli.runTransaction (Queries.loadProjectBranchByName projectId (unsafeFrom @Text "main")) <&> \case
-              Nothing -> Path.Absolute Path.empty
-              Just mainBranch -> ProjectUtils.projectBranchPath (ProjectAndBranch projectId (mainBranch ^. #branchId))
-          Just parentBranchId -> pure (ProjectUtils.projectBranchPath (ProjectAndBranch projectId parentBranchId))
+            let loadMain =
+                  Queries.loadProjectBranchByName projectAndBranchToDelete.project.projectId (unsafeFrom @Text "main")
+             in Cli.runTransaction loadMain <&> \case
+                  Nothing -> Path.Absolute Path.empty
+                  Just mainBranch -> ProjectUtils.projectBranchPath (ProjectUtils.justTheIds' mainBranch)
+          Just parentBranchId ->
+            pure $
+              ProjectUtils.projectBranchPath
+                (ProjectAndBranch projectAndBranchToDelete.project.projectId parentBranchId)
       Cli.cd newPath
+
+-- | Delete a project branch and record an entry in the reflog.
+doDeleteProjectBranch :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Cli ()
+doDeleteProjectBranch projectAndBranch = do
+  Cli.runTransaction do
+    Queries.deleteProjectBranch projectAndBranch.project.projectId projectAndBranch.branch.branchId
+  Cli.stepAt
+    ("delete.branch " <> into @Text (ProjectUtils.justTheNames projectAndBranch))
+    ( Path.unabsolute (ProjectUtils.projectBranchesPath projectAndBranch.project.projectId),
+      over Branch.children (Map.delete (ProjectUtils.projectBranchSegment projectAndBranch.branch.branchId))
+    )

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

@@ -18,6 +18,7 @@ import Unison.Cli.Pretty qualified as P
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch.Names qualified as Branch
 import Unison.Codebase.Editor.Output
+import Unison.Codebase.Editor.StructuredArgument qualified as SA
 import Unison.HashQualified qualified as HQ
 import Unison.HashQualified' qualified as HQ'
 import Unison.Name (Name)
@@ -81,15 +82,14 @@ handleStructuredFindI rule = do
     Referent.Ref _ <- pure r
     Just shortName <- [PPE.terms (PPED.suffixifiedPPE ppe) r]
     pure (HQ'.toHQ shortName, r)
-  let ok t@(_, Referent.Ref (Reference.DerivedId r)) = do
+  let ok (hq, Referent.Ref (Reference.DerivedId r)) = do
         oe <- Cli.runTransaction (Codebase.getTerm codebase r)
-        pure $ (t, maybe False (\e -> any ($ e) rules) oe)
-      ok t = pure (t, False)
+        pure $ (hq, maybe False (\e -> any ($ e) rules) oe)
+      ok (hq, _) = pure (hq, False)
   results0 <- traverse ok results
-  let results = Alphabetical.sortAlphabeticallyOn fst [(hq, r) | ((hq, r), True) <- results0]
-  let toNumArgs = Text.unpack . Reference.toText . Referent.toReference . view _2
-  Cli.setNumberedArgs $ map toNumArgs results
-  Cli.respond (ListStructuredFind (fst <$> results))
+  let results = Alphabetical.sortAlphabetically [hq | (hq, True) <- results0]
+  Cli.setNumberedArgs $ map SA.HashQualified results
+  Cli.respond (ListStructuredFind results)
 
 lookupRewrite ::
   (HQ.HashQualified Name -> Output) ->

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

@@ -118,25 +118,22 @@ fresh bump taken x =
 makeDependencyName :: ProjectName -> ProjectBranchName -> NameSegment
 makeDependencyName projectName branchName =
   NameSegment.unsafeParseText $
-    Text.intercalate "_" $
-      fold
-        [ case projectNameToUserProjectSlugs projectName of
-            (user, project) ->
-              fold
-                [ if Text.null user then [] else [user],
-                  [project]
-                ],
-          case classifyProjectBranchName branchName of
-            ProjectBranchNameKind'Contributor user branch -> [user, underscorify branch]
-            ProjectBranchNameKind'DraftRelease ver -> semverSegments ver ++ ["draft"]
-            ProjectBranchNameKind'Release ver -> semverSegments ver
-            ProjectBranchNameKind'NothingSpecial -> [underscorify branchName]
-        ]
+    Text.replace "-" "_" $
+      Text.intercalate "_" $
+        fold
+          [ case projectNameToUserProjectSlugs projectName of
+              (user, project) ->
+                fold
+                  [ if Text.null user then [] else [user],
+                    [project]
+                  ],
+            case classifyProjectBranchName branchName of
+              ProjectBranchNameKind'Contributor user branch -> [user, into @Text branch]
+              ProjectBranchNameKind'DraftRelease ver -> semverSegments ver ++ ["draft"]
+              ProjectBranchNameKind'Release ver -> semverSegments ver
+              ProjectBranchNameKind'NothingSpecial -> [into @Text branchName]
+          ]
   where
     semverSegments :: Semver -> [Text]
     semverSegments (Semver x y z) =
       [tShow x, tShow y, tShow z]
-
-    underscorify :: ProjectBranchName -> Text
-    underscorify =
-      Text.replace "-" "_" . into @Text

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

@@ -1,5 +1,13 @@
 module Unison.Codebase.Editor.HandleInput.Merge2
   ( handleMerge,
+
+    -- * API exported for @pull@
+    MergeInfo (..),
+    AliceMergeInfo (..),
+    BobMergeInfo (..),
+    LcaMergeInfo (..),
+    doMerge,
+    doMergeLocalBranch,
   )
 where
 
@@ -12,9 +20,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,17 +35,20 @@ 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 (..), MergeSourceAndTarget (..), MergeSourceOrTarget (..))
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli
-import Unison.Cli.ProjectUtils qualified as Cli
+import Unison.Cli.ProjectUtils qualified as ProjectUtils
 import Unison.Codebase (Codebase)
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch (Branch0)
@@ -47,8 +61,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 (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
@@ -62,7 +77,7 @@ import Unison.HashQualified qualified as HQ
 import Unison.HashQualified' qualified as HQ'
 import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs)
 import Unison.Merge.Database (MergeDatabase (..), makeMergeDatabase, referent2to1)
-import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason (..), checkDeclCoherency)
+import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason (..), checkDeclCoherency, lenientCheckDeclCoherency)
 import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames)
 import Unison.Merge.Diff qualified as Merge
 import Unison.Merge.DiffOp (DiffOp (..))
@@ -71,7 +86,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 (..))
@@ -112,12 +126,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')
@@ -126,246 +140,329 @@ 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.
+  (aliceProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch
+
+  -- 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 aliceProjectAndBranch.project
+      Just bobProjectName
+        | bobProjectName == aliceProjectAndBranch.project.name -> pure aliceProjectAndBranch.project
+        | otherwise -> do
+            Cli.runTransaction (Queries.loadProjectByName bobProjectName)
+              & onNothingM (Cli.returnEarly (Output.LocalProjectDoesntExist bobProjectName))
+  bobProjectBranch <- ProjectUtils.expectProjectBranchByName bobProject bobBranchName
+  let bobProjectAndBranch = ProjectAndBranch bobProject bobProjectBranch
+
+  doMergeLocalBranch
+    TwoWay
+      { alice = aliceProjectAndBranch,
+        bob = bobProjectAndBranch
+      }
+
+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,
+    projectAndBranch :: !(ProjectAndBranch Project 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 = ProjectUtils.projectBranchPath (ProjectUtils.justTheIds info.alice.projectAndBranch)
+  let aliceBranchNames = ProjectUtils.justTheNames info.alice.projectAndBranch
+  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
 
-  -- Create a bunch of cached database lookup functions
-  db <- makeMergeDatabase codebase
+  Cli.label \done -> do
+    -- 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.respond (Output.MergeAlreadyUpToDate2 mergeSourceAndTarget)
+      done ()
 
-  -- 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
+    -- 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.respond (Output.MergeSuccessFastForward mergeSourceAndTarget)
+      done ()
 
-  -- Load Alice/Bob/LCA causals
-  causals <-
+    -- Create a bunch of cached database lookup functions
+    db <- makeMergeDatabase codebase
+
+    -- Load Alice/Bob/LCA causals
+    causals <- Cli.runTransaction do
+      traverse
+        Operations.expectCausalBranchByCausalHash
+        TwoOrThreeWay
+          { alice = info.alice.causalHash,
+            bob = info.bob.causalHash,
+            lca = info.lca.causalHash
+          }
+
+    liftIO (debugFunctions.debugCausals causals)
+
+    -- Load Alice/Bob/LCA branches
+    branches <-
+      Cli.runTransaction do
+        alice <- causals.alice.value
+        bob <- causals.bob.value
+        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, declNameLookups, lcaDeclToConstructors) <- do
+      let emptyNametree = Nametree {value = Defns Map.empty Map.empty, children = Map.empty}
+      let loadDefns branch =
+            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
+      let load = \case
+            Nothing -> pure (emptyNametree, DeclNameLookup Map.empty Map.empty)
+            Just (who, branch) -> do
+              defns <- loadDefns branch
+              declNameLookup <-
+                Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err ->
+                  Cli.returnEarly case err of
+                    IncoherentDeclReason'ConstructorAlias typeName conName1 conName2 ->
+                      Output.MergeConstructorAlias who typeName conName1 conName2
+                    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 (mergeTarget, branches.alice))
+      (bobDefns0, bobDeclNameLookup) <- load (Just (mergeSource, branches.bob))
+      lcaDefns0 <- maybe (pure emptyNametree) loadDefns branches.lca
+      lcaDeclToConstructors <- Cli.runTransaction (lenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0)
+
+      let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns)
+      let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0}
+      let declNameLookups = TwoWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup}
+
+      pure (defns3, declNameLookups, lcaDeclToConstructors)
+
+    let defns = ThreeWay.forgetLca defns3
+
+    liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclToConstructors)
+
+    -- Diff LCA->Alice and LCA->Bob
+    diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors 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
+    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
+
+    liftIO (debugFunctions.debugCombinedDiff diff)
+
+    -- Partition the combined diff into the conflicted things and the unconflicted things
+    (conflicts, unconflicts) <-
+      partitionCombinedDiffs defns declNameLookups diff & onLeft \name ->
+        Cli.returnEarly (Output.MergeConflictInvolvingBuiltin name)
+
+    liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts)
+
+    -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there
+    -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are)
+    dependents <- Cli.runTransaction (identifyDependents defns conflicts unconflicts)
+
+    liftIO (debugFunctions.debugDependents dependents)
+
+    let stageOne :: DefnsF (Map Name) Referent TypeReference
+        stageOne =
+          makeStageOne
+            declNameLookups
+            conflicts
+            unconflicts
+            dependents
+            (bimap BiMultimap.range BiMultimap.range defns3.lca)
+
+    liftIO (debugFunctions.debugStageOne stageOne)
+
+    -- Load and merge Alice's and Bob's libdeps
+    mergedLibdeps <-
+      Cli.runTransaction do
+        libdeps <- loadLibdeps branches
+        libdepsToBranch0 db (Merge.mergeLibdeps getTwoFreshNames libdeps)
+
+    -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names
+    let mkPpes :: TwoWay Names -> Names -> TwoWay PrettyPrintEnvDecl
+        mkPpes defnsNames libdepsNames =
+          defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier
+          where
+            suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames)
+    let ppes = mkPpes (defnsToNames <$> defns) (Branch.toNames mergedLibdeps)
+
+    hydratedThings <- do
+      Cli.runTransaction do
+        for ((,) <$> conflicts <*> dependents) \(conflicts1, dependents1) ->
+          let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent codebase) Operations.expectDeclComponent
+           in (,) <$> hydrate conflicts1 <*> hydrate dependents1
+
+    let (renderedConflicts, renderedDependents) =
+          let honk declNameLookup ppe defns =
+                let (types, accessorNames) =
+                      Writer.runWriter $
+                        defns.types & Map.traverseWithKey \name (ref, typ) ->
+                          renderTypeBinding
+                            -- Sort of a hack; since the decl printer looks in the PPE for names of constructors,
+                            -- we just delete all term names out and add back the constructors...
+                            -- probably no need to wipe out the suffixified side but we do it anyway
+                            (setPpedToConstructorNames declNameLookup name ref ppe)
+                            name
+                            ref
+                            typ
+                    terms =
+                      defns.terms & Map.mapMaybeWithKey \name (term, typ) ->
+                        if Set.member name accessorNames
+                          then Nothing
+                          else Just (renderTermBinding ppe.suffixifiedPPE name term typ)
+                 in Defns {terms, types}
+           in unzip $
+                ( \declNameLookup (conflicts, dependents) ppe ->
+                    let honk1 = honk declNameLookup ppe
+                     in (honk1 conflicts, honk1 dependents)
+                )
+                  <$> declNameLookups
+                  <*> hydratedThings
+                  <*> ppes
+
+    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
+              }
+            renderedConflicts
+            renderedDependents
+
+    let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps
+
+    maybeTypecheckedUnisonFile <-
+      let thisMergeHasConflicts =
+            -- Eh, they'd either both be null, or neither, but just check both maps anyway
+            not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob)
+       in if thisMergeHasConflicts
+            then pure Nothing
+            else do
+              currentPath <- Cli.getCurrentPath
+              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
+        _temporaryBranchId <-
+          HandleInput.Branch.doCreateBranch'
+            (Branch.mergeNode stageOneBranch parents.alice parents.bob)
+            Nothing
+            info.alice.projectAndBranch.project
+            (findTemporaryBranchName info.alice.projectAndBranch.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 mergeSourceAndTarget)
+      Just tuf -> do
+        Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf)
+        let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch
+        _ <-
+          Cli.updateAt
+            info.description
+            alicePath
+            (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob)
+        Cli.respond (Output.MergeSuccess mergeSourceAndTarget)
+
+doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli ()
+doMergeLocalBranch branches = do
+  (aliceCausalHash, bobCausalHash, lcaCausalHash) <-
     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}
+      aliceCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds branches.alice)
+      bobCausalHash <- ProjectUtils.getProjectBranchCausalHash (ProjectUtils.justTheIds branches.bob)
+      -- Using Alice and Bob's causal hashes, find the LCA (if it exists)
+      lcaCausalHash <- Operations.lca aliceCausalHash bobCausalHash
+      pure (aliceCausalHash, bobCausalHash, lcaCausalHash)
 
-  -- 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)
-
-  liftIO (debugFunctions.debugCausals causals)
-
-  -- Load Alice/Bob/LCA branches
-  branches <-
-    Cli.runTransaction do
-      alice <- causals.alice.value
-      bob <- causals.bob.value
-      lca <- for causals.lca \causal -> causal.value
-      pure TwoOrThreeWay {lca, alice, bob}
-
-  -- Load Alice/Bob/LCA definitions and decl name lookups
-  (defns3, declNameLookups3) <-
-    Cli.runTransactionWithRollback \abort -> do
-      loadDefns abort db (view #branch <$> info.branches) branches
-  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
-
-  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)
-
-  -- Combine the LCA->Alice and LCA->Bob diffs together
-  let diff = combineDiffs diffs
-
-  liftIO (debugFunctions.debugCombinedDiff diff)
-
-  -- 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))
-
-  liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts)
-
-  -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there
-  -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are)
-  dependents <- Cli.runTransaction (identifyDependents defns conflicts unconflicts)
-
-  liftIO (debugFunctions.debugDependents dependents)
-
-  let stageOne :: DefnsF (Map Name) Referent TypeReference
-      stageOne =
-        makeStageOne
-          declNameLookups
-          conflicts
-          unconflicts
-          dependents
-          (bimap BiMultimap.range BiMultimap.range defns3.lca)
-
-  liftIO (debugFunctions.debugStageOne stageOne)
-
-  -- Load and merge Alice's and Bob's libdeps
-  mergedLibdeps <-
-    Cli.runTransaction do
-      libdeps <- loadLibdeps branches
-      libdepsToBranch0 db (Merge.mergeLibdeps getTwoFreshNames libdeps)
-
-  -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names
-  let mkPpes :: TwoWay Names -> Names -> TwoWay PrettyPrintEnvDecl
-      mkPpes defnsNames libdepsNames =
-        defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier
-        where
-          suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames)
-  let ppes = mkPpes (defnsToNames <$> defns) (Branch.toNames mergedLibdeps)
-
-  hydratedThings <- do
-    Cli.runTransaction do
-      for ((,) <$> conflicts <*> dependents) \(conflicts1, dependents1) ->
-        let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent codebase) Operations.expectDeclComponent
-         in (,) <$> hydrate conflicts1 <*> hydrate dependents1
-
-  let (renderedConflicts, renderedDependents) =
-        let honk declNameLookup ppe defns =
-              let (types, accessorNames) =
-                    Writer.runWriter $
-                      defns.types & Map.traverseWithKey \name (ref, typ) ->
-                        renderTypeBinding
-                          -- Sort of a hack; since the decl printer looks in the PPE for names of constructors,
-                          -- we just delete all term names out and add back the constructors...
-                          -- probably no need to wipe out the suffixified side but we do it anyway
-                          (setPpedToConstructorNames declNameLookup name ref ppe)
-                          name
-                          ref
-                          typ
-                  terms =
-                    defns.terms & Map.mapMaybeWithKey \name (term, typ) ->
-                      if Set.member name accessorNames
-                        then Nothing
-                        else Just (renderTermBinding ppe.suffixifiedPPE name term typ)
-               in Defns {terms, types}
-         in unzip $
-              ( \declNameLookup (conflicts, dependents) ppe ->
-                  let honk1 = honk declNameLookup ppe
-                   in (honk1 conflicts, honk1 dependents)
-              )
-                <$> declNameLookups
-                <*> hydratedThings
-                <*> ppes
-
-  let prettyUnisonFile = makePrettyUnisonFile (into @Text <$> projectAndBranchNames) renderedConflicts renderedDependents
-
-  let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps
-
-  maybeTypecheckedUnisonFile <-
-    let thisMergeHasConflicts =
-          -- Eh, they'd either both be null, or neither, but just check both maps anyway
-          not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob)
-     in if thisMergeHasConflicts
-          then pure Nothing
-          else do
-            currentPath <- Cli.getCurrentPath
-            parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch)
-            prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe
-
-  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)
-          Nothing
-          info.branches.alice.project
-          (findTemporaryBranchName info)
-          (textualDescriptionOfMerge info)
-      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
-    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)
+  -- Do the merge!
+  doMerge
+    MergeInfo
+      { alice =
+          AliceMergeInfo
+            { causalHash = aliceCausalHash,
+              projectAndBranch = branches.alice
+            },
+        bob =
+          BobMergeInfo
+            { causalHash = bobCausalHash,
+              source = MergeSource'LocalProjectBranch (ProjectUtils.justTheNames branches.bob)
+            },
+        lca =
+          LcaMergeInfo
+            { causalHash = lcaCausalHash
+            },
+        description = "merge " <> into @Text (ProjectUtils.justTheNames branches.bob)
+      }
 
 ------------------------------------------------------------------------------------------------------------------------
 -- 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)))
@@ -502,13 +599,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)
@@ -622,17 +722,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)) ->
@@ -750,30 +839,39 @@ 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
+  ProjectUtils.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
+    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
@@ -782,141 +880,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 ::
-  (Monad m) =>
+--
+-- 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
@@ -936,8 +947,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]
@@ -1022,7 +1034,8 @@ data DebugFunctions = DebugFunctions
   { debugCausals :: TwoOrThreeWay (V2.CausalBranch Transaction) -> IO (),
     debugDefns ::
       ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
-      ThreeWay DeclNameLookup ->
+      TwoWay DeclNameLookup ->
+      Map Name [Maybe Name] ->
       IO (),
     debugDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -> IO (),
     debugCombinedDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO (),
@@ -1063,9 +1076,10 @@ realDebugCausals causals = do
 
 realDebugDefns ::
   ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
-  ThreeWay DeclNameLookup ->
+  TwoWay DeclNameLookup ->
+  Map Name [Maybe Name] ->
   IO ()
-realDebugDefns defns declNameLookups = do
+realDebugDefns defns declNameLookups _lcaDeclNameLookup = do
   Text.putStrLn (Text.bold "\n=== Alice definitions ===")
   debugDefns1 (bimap BiMultimap.range BiMultimap.range defns.alice)
 

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

@@ -1,11 +1,13 @@
 -- | @switch@ input handler
 module Unison.Codebase.Editor.HandleInput.ProjectSwitch
   ( projectSwitch,
+    switchToProjectBranch,
   )
 where
 
-import Control.Lens ((^.))
 import Data.These (These (..))
+import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId)
+import U.Codebase.Sqlite.Project qualified
 import U.Codebase.Sqlite.Queries qualified as Queries
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
@@ -31,52 +33,47 @@ projectSwitch projectNames = do
       ProjectUtils.getCurrentProjectBranch >>= \case
         Nothing -> switchToProjectAndBranchByTheseNames (This projectName)
         Just (ProjectAndBranch currentProject _currentBranch, _restPath) -> do
-          let currentProjectName = currentProject ^. #name
           (projectExists, branchExists) <-
             Cli.runTransaction do
               (,)
                 <$> Queries.projectExistsByName projectName
-                <*> Queries.projectBranchExistsByName (currentProject ^. #projectId) branchName
+                <*> Queries.projectBranchExistsByName currentProject.projectId branchName
           case (projectExists, branchExists) of
             (False, False) -> Cli.respond (Output.LocalProjectNorProjectBranchExist projectName branchName)
-            (False, True) -> switchToProjectAndBranchByTheseNames (These currentProjectName branchName)
+            (False, True) -> switchToProjectAndBranchByTheseNames (These currentProject.name branchName)
             (True, False) -> switchToProjectAndBranchByTheseNames (This projectName)
             (True, True) ->
               Cli.respondNumbered $
                 Output.AmbiguousSwitch
                   projectName
-                  (ProjectAndBranch currentProjectName branchName)
+                  (ProjectAndBranch currentProject.name branchName)
     ProjectAndBranchNames'Unambiguous projectAndBranchNames0 ->
       switchToProjectAndBranchByTheseNames projectAndBranchNames0
 
 switchToProjectAndBranchByTheseNames :: These ProjectName ProjectBranchName -> Cli ()
 switchToProjectAndBranchByTheseNames projectAndBranchNames0 = do
-  branch <- case projectAndBranchNames0 of
-    This projectName ->
-      Cli.runTransactionWithRollback \rollback -> do
-        project <-
-          Queries.loadProjectByName projectName & onNothingM do
-            rollback (Output.LocalProjectDoesntExist projectName)
-        Queries.loadMostRecentBranch (project ^. #projectId) >>= \case
-          Nothing -> do
-            let branchName = unsafeFrom @Text "main"
-            branch <-
-              Queries.loadProjectBranchByName (project ^. #projectId) branchName & onNothingM do
-                rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName))
-            setMostRecentBranch branch
-          Just branchId ->
-            Queries.loadProjectBranch (project ^. #projectId) branchId >>= \case
-              Nothing -> error "impossible"
-              Just branch -> pure branch
-    _ -> do
-      projectAndBranchNames@(ProjectAndBranch projectName branchName) <- ProjectUtils.hydrateNames projectAndBranchNames0
-      Cli.runTransactionWithRollback \rollback -> do
-        branch <-
+  branch <-
+    case projectAndBranchNames0 of
+      This projectName ->
+        Cli.runTransactionWithRollback \rollback -> do
+          project <-
+            Queries.loadProjectByName projectName & onNothingM do
+              rollback (Output.LocalProjectDoesntExist projectName)
+          let branchName = unsafeFrom @Text "main"
+          Queries.loadProjectBranchByName project.projectId branchName & onNothingM do
+            rollback (Output.LocalProjectBranchDoesntExist (ProjectAndBranch projectName branchName))
+      _ -> do
+        projectAndBranchNames@(ProjectAndBranch projectName branchName) <- ProjectUtils.hydrateNames projectAndBranchNames0
+        Cli.runTransactionWithRollback \rollback -> do
           Queries.loadProjectBranchByNames projectName branchName & onNothingM do
             rollback (Output.LocalProjectBranchDoesntExist projectAndBranchNames)
-        setMostRecentBranch branch
-  Cli.cd (ProjectUtils.projectBranchPath (ProjectAndBranch (branch ^. #projectId) (branch ^. #branchId)))
-  where
-    setMostRecentBranch branch = do
-      Queries.setMostRecentBranch (branch ^. #projectId) (branch ^. #branchId)
-      pure branch
+  switchToProjectBranch (ProjectUtils.justTheIds' branch)
+
+-- | Switch to a branch:
+--
+-- * Record it as the most-recent branch (so it's restored when ucm starts).
+-- * Change the current path in the in-memory loop state.
+switchToProjectBranch :: ProjectAndBranch ProjectId ProjectBranchId -> Cli ()
+switchToProjectBranch x = do
+  Cli.runTransaction (Queries.setMostRecentBranch x.project x.branch)
+  Cli.cd (ProjectUtils.projectBranchPath x)

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,100 @@ 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
-    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))
+
+  remoteCausalHash <- do
+    case source of
+      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,
+                      projectAndBranch = target
+                    },
+                bob =
+                  BobMergeInfo
+                    { causalHash = remoteCausalHash,
+                      source =
+                        case source of
+                          ReadShare'ProjectBranch remoteBranch ->
+                            MergeSource'RemoteProjectBranch (ProjectAndBranch remoteBranch.projectName remoteBranch.branchName)
+                          ReadShare'LooseCode info -> MergeSource'RemoteLooseCode 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 +152,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 +173,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
@@ -163,11 +197,10 @@ resolveExplicitSource ::
   ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease) ->
   Cli (ReadRemoteNamespace Share.RemoteProjectBranch)
 resolveExplicitSource includeSquashed = \case
-  ReadRemoteNamespaceGit namespace -> pure (ReadRemoteNamespaceGit namespace)
   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
@@ -175,9 +208,9 @@ resolveExplicitSource includeSquashed = \case
         (ProjectAndBranch (remoteProjectId, remoteProjectName) remoteBranchName)
     pure (ReadShare'ProjectBranch remoteProjectBranch)
   ReadShare'ProjectBranch (That branchNameOrLatestRelease) -> do
-    (ProjectAndBranch localProject localBranch, _restPath) <- ProjectUtils.expectCurrentProjectBranch
-    let localProjectId = localProject ^. #projectId
-    let localBranchId = localBranch ^. #branchId
+    (localProjectAndBranch, _restPath) <- ProjectUtils.expectCurrentProjectBranch
+    let localProjectId = localProjectAndBranch.project.projectId
+    let localBranchId = localProjectAndBranch.branch.branchId
     Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case
       Just (remoteProjectId, _maybeProjectBranchId) -> do
         remoteProjectName <- Cli.runTransaction (Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri)
@@ -194,12 +227,10 @@ resolveExplicitSource includeSquashed = \case
         pure (ReadShare'ProjectBranch remoteProjectBranch)
       Nothing -> do
         Cli.returnEarly $
-          Output.NoAssociatedRemoteProject
-            Share.hardCodedUri
-            (ProjectAndBranch (localProject ^. #name) (localBranch ^. #name))
+          Output.NoAssociatedRemoteProject Share.hardCodedUri (ProjectUtils.justTheNames localProjectAndBranch)
   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 +241,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/HandleInput/Push.hs

@@ -1,13 +1,11 @@
 -- | @push@ input handler
 module Unison.Codebase.Editor.HandleInput.Push
-  ( handleGist,
-    handlePushRemoteBranch,
+  ( handlePushRemoteBranch,
   )
 where
 
 import Control.Concurrent.STM (atomically, modifyTVar', newTVarIO, readTVar, readTVarIO)
 import Control.Lens (over, view, (.~), (^.), _1, _2)
-import Control.Monad.Reader (ask)
 import Data.Set.NonEmpty qualified as Set.NonEmpty
 import Data.Text as Text
 import Data.These (These (..))
@@ -26,13 +24,9 @@ import Unison.Cli.MonadUtils qualified as Cli
 import Unison.Cli.ProjectUtils qualified as ProjectUtils
 import Unison.Cli.Share.Projects qualified as Share
 import Unison.Cli.UnisonConfigUtils qualified as UnisonConfigUtils
-import Unison.Codebase qualified as Codebase
-import Unison.Codebase.Branch (Branch (..))
-import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Editor.HandleInput.AuthLogin qualified as AuthLogin
 import Unison.Codebase.Editor.Input
-  ( GistInput (..),
-    PushRemoteBranchInput (..),
+  ( PushRemoteBranchInput (..),
     PushSource (..),
     PushSourceTarget (..),
   )
@@ -40,20 +34,13 @@ import Unison.Codebase.Editor.Output
 import Unison.Codebase.Editor.Output qualified as Output
 import Unison.Codebase.Editor.Output.PushPull (PushPull (Push))
 import Unison.Codebase.Editor.RemoteRepo
-  ( ReadGitRemoteNamespace (..),
-    ReadRemoteNamespace (..),
-    WriteGitRemoteNamespace (..),
-    WriteRemoteNamespace (..),
+  ( WriteRemoteNamespace (..),
     WriteShareRemoteNamespace (..),
-    writeToReadGit,
   )
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.PushBehavior (PushBehavior)
 import Unison.Codebase.PushBehavior qualified as PushBehavior
-import Unison.Codebase.ShortCausalHash qualified as SCH
-import Unison.Codebase.Type (GitPushBehavior (..))
 import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName))
-import Unison.Hash qualified as Hash
 import Unison.Hash32 (Hash32)
 import Unison.Hash32 qualified as Hash32
 import Unison.Prelude
@@ -75,25 +62,6 @@ import Unison.Sqlite qualified as Sqlite
 import Unison.Sync.Types qualified as Share
 import Witch (unsafeFrom)
 
--- | Handle a @gist@ command.
-handleGist :: GistInput -> Cli ()
-handleGist (GistInput repo) = do
-  Cli.Env {codebase} <- ask
-  sourceBranch <- Cli.getCurrentBranch
-  result <-
-    Cli.ioE (Codebase.pushGitBranch codebase repo GitPushBehaviorGist (\_remoteRoot -> pure (Right sourceBranch))) \err ->
-      Cli.returnEarly (Output.GitError err)
-  _branch <- result & onLeft Cli.returnEarly
-  schLength <- Cli.runTransaction Codebase.branchHashLength
-  Cli.respond $
-    GistCreated $
-      ReadRemoteNamespaceGit
-        ReadGitRemoteNamespace
-          { repo = writeToReadGit repo,
-            sch = Just (SCH.fromHash schLength (Branch.headHash sourceBranch)),
-            path = Path.empty
-          }
-
 -- | Handle a @push@ command.
 handlePushRemoteBranch :: PushRemoteBranchInput -> Cli ()
 handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do
@@ -104,7 +72,6 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do
         Nothing -> do
           localPath <- Cli.getCurrentPath
           UnisonConfigUtils.resolveConfiguredUrl Push Path.currentPath >>= \case
-            WriteRemoteNamespaceGit namespace -> pushLooseCodeToGitLooseCode localPath namespace pushBehavior
             WriteRemoteNamespaceShare namespace -> pushLooseCodeToShareLooseCode localPath namespace pushBehavior
             WriteRemoteProjectBranch v -> absurd v
         Just (localProjectAndBranch, _restPath) ->
@@ -112,10 +79,6 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do
             force
             localProjectAndBranch
             Nothing
-    -- push <implicit> to .some.path (git)
-    PushSourceTarget1 (WriteRemoteNamespaceGit namespace) -> do
-      localPath <- Cli.getCurrentPath
-      pushLooseCodeToGitLooseCode localPath namespace pushBehavior
     -- push <implicit> to .some.path (share)
     PushSourceTarget1 (WriteRemoteNamespaceShare namespace) -> do
       localPath <- Cli.getCurrentPath
@@ -129,10 +92,6 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do
           pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch
         Just (localProjectAndBranch, _restPath) ->
           pushProjectBranchToProjectBranch force localProjectAndBranch (Just remoteProjectAndBranch0)
-    -- push .some.path to .some.path (git)
-    PushSourceTarget2 (PathySource localPath0) (WriteRemoteNamespaceGit namespace) -> do
-      localPath <- Cli.resolvePath' localPath0
-      pushLooseCodeToGitLooseCode localPath namespace pushBehavior
     -- push .some.path to .some.path (share)
     PushSourceTarget2 (PathySource localPath0) (WriteRemoteNamespaceShare namespace) -> do
       localPath <- Cli.resolvePath' localPath0
@@ -142,13 +101,6 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do
       localPath <- Cli.resolvePath' localPath0
       remoteProjectAndBranch <- ProjectUtils.hydrateNames remoteProjectAndBranch0
       pushLooseCodeToProjectBranch force localPath remoteProjectAndBranch
-    -- push @some/project to .some.path (git)
-    PushSourceTarget2 (ProjySource localProjectAndBranch0) (WriteRemoteNamespaceGit namespace) -> do
-      ProjectAndBranch project branch <- ProjectUtils.expectProjectAndBranchByTheseNames localProjectAndBranch0
-      pushLooseCodeToGitLooseCode
-        (ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId)))
-        namespace
-        pushBehavior
     -- push @some/project to .some.path (share)
     PushSourceTarget2 (ProjySource localProjectAndBranch0) (WriteRemoteNamespaceShare namespace) -> do
       ProjectAndBranch project branch <- ProjectUtils.expectProjectAndBranchByTheseNames localProjectAndBranch0
@@ -167,49 +119,6 @@ handlePushRemoteBranch PushRemoteBranchInput {sourceTarget, pushBehavior} = do
         PushBehavior.RequireEmpty -> False
         PushBehavior.RequireNonEmpty -> False
 
--- Push a local namespace ("loose code") to a Git-hosted remote namespace ("loose code").
-pushLooseCodeToGitLooseCode :: Path.Absolute -> WriteGitRemoteNamespace -> PushBehavior -> Cli ()
-pushLooseCodeToGitLooseCode localPath gitRemotePath pushBehavior = do
-  sourceBranch <- Cli.getBranchAt localPath
-  let withRemoteRoot :: Branch IO -> Either Output (Branch IO)
-      withRemoteRoot remoteRoot = do
-        let -- We don't merge `sourceBranch` with `remoteBranch`, we just replace it. This push will be rejected if
-            -- this rewinds time or misses any new updates in the remote branch that aren't in `sourceBranch`
-            -- already.
-            f remoteBranch = if shouldPushTo pushBehavior remoteBranch then Just sourceBranch else Nothing
-        case Branch.modifyAtM (gitRemotePath ^. #path) f remoteRoot of
-          Nothing -> Left (RefusedToPush pushBehavior (WriteRemoteNamespaceGit gitRemotePath))
-          Just newRemoteRoot -> Right newRemoteRoot
-  let behavior =
-        case pushBehavior of
-          PushBehavior.ForcePush -> GitPushBehaviorForce
-          PushBehavior.RequireEmpty -> GitPushBehaviorFf
-          PushBehavior.RequireNonEmpty -> GitPushBehaviorFf
-  Cli.Env {codebase} <- ask
-  let push =
-        Codebase.pushGitBranch
-          codebase
-          (gitRemotePath ^. #repo)
-          behavior
-          (\remoteRoot -> pure (withRemoteRoot remoteRoot))
-  result <-
-    liftIO push & onLeftM \err ->
-      Cli.returnEarly (Output.GitError err)
-  _branch <- result & onLeft Cli.returnEarly
-  Cli.respond Success
-  where
-    -- Per `pushBehavior`, we are either:
-    --
-    --   (1) force-pushing, in which case the remote branch state doesn't matter
-    --   (2) updating an empty branch, which fails if the branch isn't empty (`push.create`)
-    --   (3) updating a non-empty branch, which fails if the branch is empty (`push`)
-    shouldPushTo :: PushBehavior -> Branch m -> Bool
-    shouldPushTo pushBehavior remoteBranch =
-      case pushBehavior of
-        PushBehavior.ForcePush -> True
-        PushBehavior.RequireEmpty -> Branch.isEmpty0 (Branch.head remoteBranch)
-        PushBehavior.RequireNonEmpty -> not (Branch.isEmpty0 (Branch.head remoteBranch))
-
 -- Push a local namespace ("loose code") to a Share-hosted remote namespace ("loose code").
 pushLooseCodeToShareLooseCode :: Path.Absolute -> WriteShareRemoteNamespace -> PushBehavior -> Cli ()
 pushLooseCodeToShareLooseCode _ _ _ = do
@@ -649,10 +558,11 @@ makeSetHeadAfterUploadAction ::
   Share.RemoteProjectBranch ->
   Cli AfterUploadAction
 makeSetHeadAfterUploadAction force pushing localBranchHead remoteBranch = do
-  let remoteProjectAndBranchNames = ProjectAndBranch (remoteBranch ^. #projectName) (remoteBranch ^. #branchName)
+  let remoteProjectAndBranchNames = ProjectAndBranch remoteBranch.projectName remoteBranch.branchName
 
-  when (localBranchHead == Share.API.hashJWTHash (remoteBranch ^. #branchHead)) do
-    Cli.returnEarly (RemoteProjectBranchIsUpToDate Share.hardCodedUri remoteProjectAndBranchNames)
+  when (localBranchHead == Share.API.hashJWTHash remoteBranch.branchHead) do
+    Cli.respond (RemoteProjectBranchIsUpToDate Share.hardCodedUri remoteProjectAndBranchNames)
+    Cli.returnEarly (ViewOnShare (Right (Share.hardCodedUri, remoteBranch.projectName, remoteBranch.branchName)))
 
   when (not force) do
     whenM (Cli.runTransaction (wouldNotBeFastForward localBranchHead remoteBranchHead)) do

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

@@ -20,6 +20,8 @@ import Unison.Codebase.Editor.Output qualified as Output
 import Unison.Codebase.MainTerm qualified as MainTerm
 import Unison.Codebase.Runtime qualified as Runtime
 import Unison.Hash qualified as Hash
+import Unison.HashQualified qualified as HQ
+import Unison.Name (Name)
 import Unison.Parser.Ann (Ann (External))
 import Unison.Prelude
 import Unison.PrettyPrintEnv qualified as PPE
@@ -40,7 +42,7 @@ import Unison.UnisonFile qualified as UF
 import Unison.UnisonFile.Names qualified as UF
 import Unison.Var qualified as Var
 
-handleRun :: Bool -> Text -> [String] -> Cli ()
+handleRun :: Bool -> HQ.HashQualified Name -> [String] -> Cli ()
 handleRun native main args = do
   (unisonFile, mainResType) <- do
     (sym, term, typ, otyp) <- getTerm main
@@ -75,7 +77,7 @@ data GetTermResult
 -- | Look up runnable term with the given name in the codebase or
 -- latest typechecked unison file. Return its symbol, term, type, and
 -- the type of the evaluated term.
-getTerm :: Text -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
+getTerm :: HQ.HashQualified Name -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
 getTerm main =
   getTerm' main >>= \case
     NoTermWithThatName -> do
@@ -90,7 +92,7 @@ getTerm main =
       Cli.returnEarly $ Output.BadMainFunction "run" main ty suffixifiedPPE [mainType]
     GetTermSuccess x -> pure x
 
-getTerm' :: Text -> Cli GetTermResult
+getTerm' :: HQ.HashQualified Name -> Cli GetTermResult
 getTerm' mainName =
   let getFromCodebase = do
         Cli.Env {codebase, runtime} <- ask
@@ -99,7 +101,6 @@ getTerm' mainName =
         mainToFile
           =<< MainTerm.getMainTerm loadTypeOfTerm names mainName (Runtime.mainType runtime)
         where
-          mainToFile (MainTerm.NotAFunctionName _) = pure NoTermWithThatName
           mainToFile (MainTerm.NotFound _) = pure NoTermWithThatName
           mainToFile (MainTerm.BadType _ ty) = pure $ maybe NoTermWithThatName TermHasBadType ty
           mainToFile (MainTerm.Success hq tm typ) =
@@ -108,7 +109,8 @@ getTerm' mainName =
                   pure (GetTermSuccess (v, tm, typ, otyp))
       getFromFile uf = do
         let components = join $ UF.topLevelComponents uf
-        let mainComponent = filter ((\v -> Var.name v == mainName) . view _1) components
+        -- __TODO__: We shouldn’t need to serialize mainName` for this check
+        let mainComponent = filter ((\v -> Var.name v == HQ.toText mainName) . view _1) components
         case mainComponent of
           [(v, _, tm, ty)] ->
             checkType ty \otyp ->

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

@@ -31,7 +31,6 @@ import Unison.PrettyPrintEnvDecl qualified as PPED
 import Unison.Reference (Reference)
 import Unison.Referent (Referent, pattern Con, pattern Ref)
 import Unison.Symbol (Symbol)
-import Unison.Syntax.HashQualified qualified as HQ (toText)
 import Unison.Type (Type)
 import Unison.Typechecker qualified as Typechecker
 
@@ -118,9 +117,8 @@ resolveMainRef main = do
   pped <- Cli.prettyPrintEnvDeclFromNames names
   let suffixifiedPPE = PPED.suffixifiedPPE pped
   let mainType = Runtime.mainType runtime
-      smain = HQ.toText main
   lookupTermRefWithType codebase main >>= \case
     [(rf, ty)]
       | Typechecker.fitsScheme ty mainType -> pure (rf, suffixifiedPPE)
-      | otherwise -> Cli.returnEarly (BadMainFunction "main" smain ty suffixifiedPPE [mainType])
-    _ -> Cli.returnEarly (NoMainFunction smain suffixifiedPPE [mainType])
+      | otherwise -> Cli.returnEarly (BadMainFunction "main" main ty suffixifiedPPE [mainType])
+    _ -> Cli.returnEarly (NoMainFunction main suffixifiedPPE [mainType])

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

@@ -28,6 +28,8 @@ import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
 import Unison.Codebase.Editor.Input (TestInput (..))
 import Unison.Codebase.Editor.Output
 import Unison.Codebase.Editor.Output qualified as Output
+import Unison.Codebase.Path (Path)
+import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Runtime qualified as Runtime
 import Unison.ConstructorReference (GConstructorReference (..))
 import Unison.HashQualified qualified as HQ
@@ -38,6 +40,7 @@ import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.PrettyPrintEnv qualified as PPE
 import Unison.PrettyPrintEnvDecl qualified as PPED
+import Unison.Reference (TermReferenceId)
 import Unison.Reference qualified as Reference
 import Unison.Referent qualified as Referent
 import Unison.ShortHash qualified as SH
@@ -53,9 +56,6 @@ import Unison.Util.Monoid (foldMapM)
 import Unison.Util.Relation qualified as R
 import Unison.Util.Set qualified as Set
 import Unison.WatchKind qualified as WK
-import Unison.Codebase.Path (Path)
-import Unison.Reference (TermReferenceId)
-import qualified Unison.Codebase.Path as Path
 
 -- | Handle a @test@ command.
 -- Run pure tests in the current subnamespace.
@@ -137,7 +137,7 @@ handleIOTest main = do
   (fails, oks) <-
     refs & foldMapM \(ref, typ) -> do
       when (not $ isIOTest typ) do
-        Cli.returnEarly (BadMainFunction "io.test" (HQ.toText main) typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime))
+        Cli.returnEarly (BadMainFunction "io.test" main typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime))
       runIOTest suffixifiedPPE ref
   Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails
 

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

@@ -10,6 +10,7 @@ import Data.List.NonEmpty (pattern (:|))
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Text qualified as Text
+import Text.Builder qualified
 import U.Codebase.Sqlite.DbId (ProjectId)
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
@@ -169,8 +170,7 @@ handleUpgrade oldName newName = do
           Nothing -> "scratch.u"
           Just (file, _) -> file
       liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile)
-      Cli.respond (Output.UpgradeFailure scratchFilePath oldName newName)
-      Cli.returnEarlyWithoutOutput
+      Cli.returnEarly (Output.UpgradeFailure scratchFilePath oldName newName)
 
   branchUpdates <-
     Cli.runTransactionWithRollback \abort -> do
@@ -267,12 +267,25 @@ makeOldDepPPE oldName newName currentDeepNamesSansOld oldDeepNames oldLocalNames
 -- like "upgrade-<oldDepName>-to-<newDepName>".
 findTemporaryBranchName :: ProjectId -> NameSegment -> NameSegment -> Transaction ProjectBranchName
 findTemporaryBranchName projectId oldDepName newDepName = do
-  Cli.findTemporaryBranchName projectId preferred
+  Cli.findTemporaryBranchName projectId $
+    -- First try something like
+    --
+    --   upgrade-unison_base_3_0_0-to-unison_base_4_0_0
+    --
+    -- and if that fails (which it shouldn't, but may because of symbols or something), back off to some
+    -- more-guaranteed-to-work mangled name like
+    --
+    --   upgrade-unisonbase300-to-unisonbase400
+    tryFrom @Text (mk oldDepText newDepText)
+      & fromRight (unsafeFrom @Text (mk (scrub oldDepText) (scrub newDepText)))
   where
-    preferred :: ProjectBranchName
-    preferred =
-      unsafeFrom @Text $
-        "upgrade-"
-          <> Text.filter Char.isAlpha (NameSegment.toEscapedText oldDepName)
-          <> "-to-"
-          <> Text.filter Char.isAlpha (NameSegment.toEscapedText newDepName)
+    mk :: Text -> Text -> Text
+    mk old new =
+      Text.Builder.run ("upgrade-" <> Text.Builder.text old <> "-to-" <> Text.Builder.text new)
+
+    scrub :: Text -> Text
+    scrub =
+      Text.filter Char.isAlphaNum
+
+    oldDepText = NameSegment.toEscapedText oldDepName
+    newDepText = NameSegment.toEscapedText newDepName

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

@@ -1,8 +1,6 @@
 module Unison.Codebase.Editor.Input
   ( Input (..),
     BranchSourceI (..),
-    DiffNamespaceToPatchInput (..),
-    GistInput (..),
     PullSourceTarget (..),
     PushRemoteBranchInput (..),
     PushSourceTarget (..),
@@ -32,16 +30,14 @@ where
 import Data.List.NonEmpty (NonEmpty)
 import Data.Text qualified as Text
 import Data.These (These)
-import U.Codebase.HashTags (CausalHash)
 import Unison.Codebase.Branch.Merge qualified as Branch
-import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteGitRepo, WriteRemoteNamespace)
+import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteRemoteNamespace)
 import Unison.Codebase.Path (Path, Path')
 import Unison.Codebase.Path qualified as Path
 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)
@@ -53,7 +49,6 @@ import Unison.Util.Pretty qualified as P
 
 data Event
   = UnisonFileChanged SourceName Source
-  | IncomingRootBranch (Set CausalHash)
   deriving stock (Show)
 
 type Source = Text -- "id x = x\nconst a b = a"
@@ -114,7 +109,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
@@ -145,8 +140,6 @@ data Input
     MoveTermI Path.HQSplit' Path.Split'
   | MoveTypeI Path.HQSplit' Path.Split'
   | MoveBranchI Path.Path' Path.Path'
-  | MovePatchI Path.Split' Path.Split'
-  | CopyPatchI Path.Split' Path.Split'
   | -- delete = unname
     DeleteI DeleteTarget
   | -- edits stuff:
@@ -158,20 +151,12 @@ data Input
   | Update2I
   | PreviewUpdateI (Set Name)
   | TodoI (Maybe PatchPath) Path'
-  | PropagatePatchI PatchPath Path'
-  | ListEditsI (Maybe PatchPath)
-  | -- -- create and remove update directives
-    DeprecateTermI PatchPath Path.HQSplit'
-  | DeprecateTypeI PatchPath Path.HQSplit'
-  | ReplaceI (HQ.HashQualified Name) (HQ.HashQualified Name) (Maybe PatchPath)
-  | RemoveTermReplacementI (HQ.HashQualified Name) (Maybe PatchPath)
-  | RemoveTypeReplacementI (HQ.HashQualified Name) (Maybe PatchPath)
   | UndoI
   | -- First `Maybe Int` is cap on number of results, if any
     -- Second `Maybe Int` is cap on diff elements shown, if any
     HistoryI (Maybe Int) (Maybe Int) BranchId
   | -- execute an IO thunk with args
-    ExecuteI Text [String]
+    ExecuteI (HQ.HashQualified Name) [String]
   | -- save the result of a previous Execute
     SaveExecuteResultI Name
   | -- execute an IO [Result]
@@ -181,7 +166,7 @@ data Input
   | -- make a standalone binary file
     MakeStandaloneI String (HQ.HashQualified Name)
   | -- execute an IO thunk using scheme
-    ExecuteSchemeI Text [String]
+    ExecuteSchemeI (HQ.HashQualified Name) [String]
   | -- compile to a scheme file
     CompileSchemeI Text (HQ.HashQualified Name)
   | TestI TestInput
@@ -189,16 +174,14 @@ data Input
   | -- Display provided definitions.
     DisplayI OutputLocation (NonEmpty (HQ.HashQualified Name))
   | -- Display docs for provided terms.
-    DocsI (NonEmpty Path.HQSplit')
+    DocsI (NonEmpty Name)
   | -- other
     FindI Bool FindScope [String] -- FindI isVerbose findScope query
   | FindShallowI Path'
-  | FindPatchI
   | StructuredFindI FindScope (HQ.HashQualified Name) -- sfind findScope query
   | 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)
@@ -226,10 +209,8 @@ data Input
   | UiI Path'
   | DocToMarkdownI Name
   | DocsToHtmlI Path' FilePath
-  | GistI GistInput
   | AuthLoginI
   | VersionI
-  | DiffNamespaceToPatchI DiffNamespaceToPatchInput
   | ProjectCreateI Bool {- try downloading base? -} (Maybe ProjectName)
   | ProjectRenameI ProjectName
   | ProjectSwitchI ProjectAndBranchNames
@@ -244,6 +225,7 @@ data Input
   | -- New merge algorithm: merge the given project branch into the current one.
     MergeI (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
   | LibInstallI !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease))
+  | UpgradeCommitI
   deriving (Eq, Show)
 
 -- | The source of a `branch` command: what to make the new branch from.
@@ -256,27 +238,11 @@ data BranchSourceI
     BranchSourceI'LooseCodeOrProject LooseCodeOrProject
   deriving stock (Eq, Show)
 
-data DiffNamespaceToPatchInput = DiffNamespaceToPatchInput
-  { -- The first/earlier namespace.
-    branchId1 :: BranchId,
-    -- The second/later namespace.
-    branchId2 :: BranchId,
-    -- Where to store the patch that corresponds to the diff between the namespaces.
-    patch :: Path.Split'
-  }
-  deriving stock (Eq, Generic, Show)
-
--- | @"push.gist repo"@ pushes the contents of the current namespace to @repo@.
-data GistInput = GistInput
-  { repo :: WriteGitRepo
-  }
-  deriving stock (Eq, Show)
-
 -- | Pull source and target: either neither is specified, or only a source, or both.
 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
@@ -335,8 +301,7 @@ data DeleteTarget
   = DeleteTarget'TermOrType DeleteOutput [Path.HQSplit']
   | DeleteTarget'Term DeleteOutput [Path.HQSplit']
   | DeleteTarget'Type DeleteOutput [Path.HQSplit']
-  | DeleteTarget'Namespace Insistence (Maybe Path.Split')
-  | DeleteTarget'Patch Path.Split'
+  | DeleteTarget'Namespace Insistence (Maybe Path.Split)
   | DeleteTarget'ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
   | DeleteTarget'Project ProjectName
   deriving stock (Eq, Show)

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

@@ -17,7 +17,6 @@ module Unison.Codebase.Editor.Output
 where
 
 import Data.List.NonEmpty (NonEmpty)
-import Data.Set qualified as Set
 import Data.Set.NonEmpty (NESet)
 import Data.Time (UTCTime)
 import Network.URI (URI)
@@ -28,6 +27,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 (MergeSourceAndTarget, MergeSourceOrTarget)
 import Unison.Cli.Share.Projects.Types qualified as Share
 import Unison.Codebase.Editor.Input
 import Unison.Codebase.Editor.Output.BranchDiff (BranchDiffOutput)
@@ -36,16 +36,15 @@ import Unison.Codebase.Editor.Output.PushPull (PushPull)
 import Unison.Codebase.Editor.RemoteRepo
 import Unison.Codebase.Editor.SlurpResult (SlurpResult (..))
 import Unison.Codebase.Editor.SlurpResult qualified as SR
+import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
 import Unison.Codebase.Editor.TodoOutput qualified as TO
 import Unison.Codebase.IntegrityCheck (IntegrityResult (..))
-import Unison.Codebase.Patch (Patch)
 import Unison.Codebase.Path (Path')
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.PushBehavior (PushBehavior)
 import Unison.Codebase.Runtime qualified as Runtime
 import Unison.Codebase.ShortCausalHash (ShortCausalHash)
 import Unison.Codebase.ShortCausalHash qualified as SCH
-import Unison.Codebase.Type (GitError)
 import Unison.CommandLine.InputPattern qualified as Input
 import Unison.DataDeclaration qualified as DD
 import Unison.DataDeclaration.ConstructorId (ConstructorId)
@@ -62,7 +61,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 (..))
@@ -84,7 +83,12 @@ type ListDetailed = Bool
 
 type SourceName = Text
 
-type NumberedArgs = [String]
+-- |
+--
+--  __NB__: This only temporarily holds `Text`. Until all of the inputs are
+--          updated to handle `StructuredArgument`s, we need to ensure that the
+--          serialization remains unchanged.
+type NumberedArgs = [StructuredArgument]
 
 type HashLength = Int
 
@@ -127,7 +131,6 @@ data NumberedOutput
       HashLength
       [(CausalHash, Names.Diff)]
       HistoryTail -- 'origin point' of this view of history.
-  | ListEdits Patch PPE.PrettyPrintEnv
   | ListProjects [Sqlite.Project]
   | ListBranches ProjectName [(ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])]
   | AmbiguousSwitch ProjectName (ProjectAndBranch ProjectName ProjectBranchName)
@@ -154,13 +157,13 @@ data Output
   | InvalidSourceName String
   | SourceLoadFailed String
   | -- No main function, the [Type v Ann] are the allowed types
-    NoMainFunction Text PPE.PrettyPrintEnv [Type Symbol Ann]
+    NoMainFunction (HQ.HashQualified Name) PPE.PrettyPrintEnv [Type Symbol Ann]
   | -- | Function found, but has improper type
     -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main".
     BadMainFunction
       Text
       -- ^ what we were trying to do (e.g. "run", "io.test")
-      Text
+      (HQ.HashQualified Name)
       -- ^ name of function
       (Type Symbol Ann)
       -- ^ bad type of function
@@ -172,7 +175,6 @@ data Output
   | CreatedNewBranch Path.Absolute
   | BranchAlreadyExists Path'
   | FindNoLocalMatches
-  | PatchAlreadyExists Path.Split'
   | NoExactTypeMatches
   | TypeAlreadyExists Path.Split' (Set Reference)
   | TypeParseError String (Parser.Err Symbol)
@@ -191,13 +193,11 @@ data Output
   | EmptyProjectBranchPush (ProjectAndBranch ProjectName ProjectBranchName)
   | NameNotFound Path.HQSplit'
   | NamesNotFound [Name]
-  | PatchNotFound Path.Split'
   | TypeNotFound Path.HQSplit'
   | TermNotFound Path.HQSplit'
   | MoveNothingFound Path'
   | TypeNotFound' ShortHash
   | TermNotFound' ShortHash
-  | TypeTermMismatch (HQ.HashQualified Name) (HQ.HashQualified Name)
   | NoLastRunResult
   | SaveTermNameConflict Name
   | SearchTermsNotFound [HQ.HashQualified Name]
@@ -230,7 +230,6 @@ data Output
       -- list of all the definitions within this branch
   | ListOfDefinitions FindScope PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann]
   | ListShallow (IO PPE.PrettyPrintEnv) [ShallowListEntry Symbol Ann]
-  | ListOfPatches (Set Name)
   | ListStructuredFind [HQ.HashQualified Name]
   | -- ListStructuredFind patternMatchingUsages termBodyUsages
     -- show the result of add/update
@@ -267,32 +266,30 @@ data Output
     -- todo: eventually replace these sets with [SearchResult' v Ann]
     -- and a nicer render.
     BustedBuiltins (Set Reference) (Set Reference)
-  | GitError GitError
   | ShareError ShareError
   | ViewOnShare (Either WriteShareRemoteNamespace (URI, ProjectName, ProjectBranchName))
   | NoConfiguredRemoteMapping PushPull Path.Absolute
   | ConfiguredRemoteMappingParseError PushPull Path.Absolute Text String
   | TermMissingType Reference
   | AboutToPropagatePatch
-  | -- todo: tell the user to run `todo` on the same patch they just used
-    NothingToPatch PatchPath Path'
   | PatchNeedsToBeConflictFree
   | PatchInvolvesExternalDependents PPE.PrettyPrintEnv (Set Reference)
-  | WarnIncomingRootBranch ShortCausalHash (Set ShortCausalHash)
   | StartOfCurrentPathHistory
   | 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))
@@ -303,7 +300,7 @@ data Output
   | ListDependencies PPE.PrettyPrintEnv (Set LabeledDependency) [HQ.HashQualified Name] [HQ.HashQualified Name] -- types, terms
   | -- | List dependents of a type or term.
     ListDependents PPE.PrettyPrintEnv (Set LabeledDependency) [HQ.HashQualified Name] [HQ.HashQualified Name] -- types, terms
-  | DumpNumberedArgs NumberedArgs
+  | DumpNumberedArgs HashLength NumberedArgs
   | DumpBitBooster CausalHash (Map CausalHash [CausalHash])
   | DumpUnisonFileHashes Int [(Name, Reference.Id)] [(Name, Reference.Id)] [(Name, Reference.Id)]
   | BadName Text
@@ -395,20 +392,20 @@ 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 !MergeSourceOrTarget !Name !Name !Name
+  | MergeDefnsInLib !MergeSourceOrTarget
+  | MergeMissingConstructorName !MergeSourceOrTarget !Name
+  | MergeNestedDeclAlias !MergeSourceOrTarget !Name !Name
+  | MergeStrayConstructor !MergeSourceOrTarget !Name
   | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment
+  | NoUpgradeInProgress
 
 data UpdateOrUpgrade = UOUUpdate | UOUUpgrade
 
@@ -487,7 +484,6 @@ isFailure o = case o of
   BranchAlreadyExists {} -> True
   -- we do a global search after finding no local matches, so let's not call this a failure yet
   FindNoLocalMatches {} -> False
-  PatchAlreadyExists {} -> True
   NoExactTypeMatches -> True
   BranchEmpty {} -> True
   EmptyLooseCodePush {} -> True
@@ -507,13 +503,11 @@ isFailure o = case o of
   BranchNotFound {} -> True
   NameNotFound {} -> True
   NamesNotFound _ -> True
-  PatchNotFound {} -> True
   TypeNotFound {} -> True
   TypeNotFound' {} -> True
   TermNotFound {} -> True
   MoveNothingFound {} -> True
   TermNotFound' {} -> True
-  TypeTermMismatch {} -> True
   SearchTermsNotFound ts -> not (null ts)
   SearchTermsNotFoundDetailed _ misses otherHits -> not (null misses && null otherHits)
   DeleteBranchConfirmation {} -> False
@@ -523,7 +517,6 @@ isFailure o = case o of
   DeletedEverything -> False
   ListNames _ _ tys tms -> null tms && null tys
   ListOfDefinitions _ _ _ ds -> null ds
-  ListOfPatches s -> Set.null s
   ListStructuredFind tms -> null tms
   SlurpOutput _ _ sr -> not $ SR.isOk sr
   ParseErrors {} -> True
@@ -541,15 +534,12 @@ isFailure o = case o of
   TestIncrementalOutputEnd {} -> False
   TestResults _ _ _ _ _ fails -> not (null fails)
   CantUndo {} -> True
-  GitError {} -> True
   BustedBuiltins {} -> True
   NoConfiguredRemoteMapping {} -> True
   ConfiguredRemoteMappingParseError {} -> True
   PatchNeedsToBeConflictFree {} -> True
   PatchInvolvesExternalDependents {} -> True
   AboutToPropagatePatch {} -> False
-  NothingToPatch {} -> False
-  WarnIncomingRootBranch {} -> False
   StartOfCurrentPathHistory -> True
   NotImplemented -> True
   DumpNumberedArgs {} -> False
@@ -560,6 +550,7 @@ isFailure o = case o of
   AboutToMerge {} -> False
   MergeOverEmpty {} -> False
   MergeAlreadyUpToDate {} -> False
+  MergeAlreadyUpToDate2 {} -> False
   PreviewMergeAlreadyUpToDate {} -> False
   NoConflictsOrEdits {} -> False
   ListShallow _ es -> null es
@@ -646,11 +637,12 @@ isFailure o = case o of
   MergeConflictedTypeName {} -> True
   MergeConflictInvolvingBuiltin {} -> True
   MergeConstructorAlias {} -> True
-  MergeDefnsInLib -> True
+  MergeDefnsInLib {} -> True
   MergeMissingConstructorName {} -> True
   MergeNestedDeclAlias {} -> True
   MergeStrayConstructor {} -> True
   InstalledLibdep {} -> False
+  NoUpgradeInProgress {} -> True
 
 isNumberedFailure :: NumberedOutput -> Bool
 isNumberedFailure = \case
@@ -661,7 +653,6 @@ isNumberedFailure = \case
   DeletedDespiteDependents {} -> False
   History {} -> False
   ListBranches {} -> False
-  ListEdits {} -> False
   ListProjects {} -> False
   ShowDiffAfterCreateAuthor {} -> False
   ShowDiffAfterDeleteBranch {} -> False

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

@@ -0,0 +1,29 @@
+module Unison.Codebase.Editor.StructuredArgument where
+
+import GHC.Generics (Generic)
+import U.Codebase.HashTags (CausalHash)
+import Unison.Codebase.Editor.Input
+import Unison.Codebase.Path (Path, Path')
+import Unison.Codebase.Path qualified as Path
+import Unison.HashQualified qualified as HQ
+import Unison.HashQualified' qualified as HQ'
+import Unison.Name (Name)
+import Unison.Parser.Ann (Ann)
+import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName)
+import Unison.Server.Backend (ShallowListEntry)
+import Unison.Server.SearchResult (SearchResult)
+import Unison.Symbol (Symbol)
+
+-- | The types that can be referenced by a numeric command argument.
+data StructuredArgument
+  = AbsolutePath Path.Absolute
+  | Name Name
+  | HashQualified (HQ.HashQualified Name)
+  | Project ProjectName
+  | ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
+  | Namespace CausalHash
+  | NameWithBranchPrefix AbsBranchId Name
+  | HashQualifiedWithBranchPrefix AbsBranchId (HQ'.HashQualified Name)
+  | ShallowListEntry Path' (ShallowListEntry Symbol Ann)
+  | SearchResult (Maybe Path) SearchResult
+  deriving (Eq, Generic, Show)

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

@@ -1,36 +1,26 @@
 module Unison.Codebase.Editor.UriParser
   ( readRemoteNamespaceParser,
-    writeGitRepo,
-    deprecatedWriteGitRemoteNamespace,
     writeRemoteNamespace,
     writeRemoteNamespaceWith,
     parseReadShareLooseCode,
   )
 where
 
-import Data.Char (isAlphaNum, isDigit, isSpace)
-import Data.Sequence as Seq
+import Data.Char (isAlphaNum)
 import Data.Text qualified as Text
 import Data.These (These)
 import Data.Void
 import Text.Megaparsec qualified as P
 import Text.Megaparsec.Char qualified as C
-import U.Util.Base32Hex qualified as Base32Hex
 import Unison.Codebase.Editor.RemoteRepo
-  ( ReadGitRemoteNamespace (..),
-    ReadGitRepo (..),
-    ReadRemoteNamespace (..),
+  ( ReadRemoteNamespace (..),
     ReadShareLooseCode (..),
     ShareCodeserver (DefaultCodeserver),
     ShareUserHandle (..),
-    WriteGitRemoteNamespace (..),
-    WriteGitRepo (..),
     WriteRemoteNamespace (..),
     WriteShareRemoteNamespace (..),
   )
-import Unison.Codebase.Path (Path (..))
 import Unison.Codebase.Path qualified as Path
-import Unison.Codebase.ShortCausalHash (ShortCausalHash (..))
 import Unison.NameSegment (NameSegment)
 import Unison.Prelude
 import Unison.Project (ProjectBranchName, ProjectBranchSpecifier (..), ProjectName, projectAndBranchNamesParser)
@@ -41,30 +31,10 @@ import Unison.Util.Pretty.MegaParsec qualified as P
 
 type P = P.Parsec Void Text.Text
 
--- Here are the git protocols that we know how to parse
--- Local Protocol
-
--- $ git clone /srv/git/project.git
-
--- $ git clone /srv/git/project.git[:treeish][:[#hash][.path]]
--- File Protocol
-
--- $ git clone file:///srv/git/project.git[:treeish][:[#hash][.path]]
--- Smart / Dumb HTTP protocol
-
--- $ git clone https://example.com/gitproject.git[:treeish][:[#hash][.path]]
--- SSH Protocol
-
--- $ git clone ssh://[user@]server/project.git[:treeish][:[#hash][.path]]
-
--- $ git clone [user@]server:project.git[:treeish][:[#hash][.path]]
-
 readRemoteNamespaceParser :: ProjectBranchSpecifier branch -> P (ReadRemoteNamespace (These ProjectName branch))
 readRemoteNamespaceParser specifier =
-  P.label "generic repo" $
-    ReadRemoteNamespaceGit <$> readGitRemoteNamespace
-      <|> ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier
-      <|> ReadShare'LooseCode <$> readShareLooseCode
+  ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier
+    <|> ReadShare'LooseCode <$> readShareLooseCode
 
 projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths ::
   ProjectBranchSpecifier branch ->
@@ -82,9 +52,7 @@ parseReadShareLooseCode label input =
    in first printError (P.parse readShareLooseCode label (Text.pack input))
 
 -- >>> P.parseMaybe writeRemoteNamespace "unisonweb.base._releases.M4"
--- >>> P.parseMaybe writeRemoteNamespace "git(git@github.com:unisonweb/base:v3)._releases.M3"
 -- Just (WriteRemoteNamespaceShare (WriteShareRemoteNamespace {server = ShareRepo, repo = "unisonweb", path = base._releases.M4}))
--- Just (WriteRemoteNamespaceGit (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "git@github.com:unisonweb/base", branch = Just "v3"}, path = _releases.M3}))
 writeRemoteNamespace :: P (WriteRemoteNamespace (These ProjectName ProjectBranchName))
 writeRemoteNamespace =
   writeRemoteNamespaceWith
@@ -92,8 +60,7 @@ writeRemoteNamespace =
 
 writeRemoteNamespaceWith :: P a -> P (WriteRemoteNamespace a)
 writeRemoteNamespaceWith projectBranchParser =
-  WriteRemoteNamespaceGit <$> writeGitRemoteNamespace
-    <|> WriteRemoteProjectBranch <$> projectBranchParser
+  WriteRemoteProjectBranch <$> projectBranchParser
     <|> WriteRemoteNamespaceShare <$> writeShareRemoteNamespace
 
 -- >>> P.parseMaybe writeShareRemoteNamespace "unisonweb.base._releases.M4"
@@ -109,7 +76,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" $
@@ -131,252 +98,15 @@ shareUserHandle :: P ShareUserHandle
 shareUserHandle = do
   ShareUserHandle . Text.pack <$> P.some (P.satisfy \c -> isAlphaNum c || c == '-' || c == '_')
 
--- >>> P.parseMaybe readGitRemoteNamespace "git(user@server:project.git:branch)#asdf"
--- >>> P.parseMaybe readGitRemoteNamespace "git(user@server:project.git:branch)#asdf."
--- >>> P.parseMaybe readGitRemoteNamespace "git(user@server:project.git:branch)"
--- >>> P.parseMaybe readGitRemoteNamespace "git(git@github.com:unisonweb/base:v3)._releases.M3"
--- >>> P.parseMaybe readGitRemoteNamespace "git( user@server:project.git:branch )#asdf.foo.bar"
--- Just (ReadGitRemoteNamespace {repo = ReadGitRepo {url = "user@server:project.git", ref = Just "branch"}, sch = Just #asdf, path = })
--- Just (ReadGitRemoteNamespace {repo = ReadGitRepo {url = "user@server:project.git", ref = Just "branch"}, sch = Just #asdf, path = })
--- Just (ReadGitRemoteNamespace {repo = ReadGitRepo {url = "user@server:project.git", ref = Just "branch"}, sch = Nothing, path = })
--- Just (ReadGitRemoteNamespace {repo = ReadGitRepo {url = "git@github.com:unisonweb/base", ref = Just "v3"}, sch = Nothing, path = _releases.M3})
--- Just (ReadGitRemoteNamespace {repo = ReadGitRepo {url = "user@server:project.git", ref = Just "branch"}, sch = Just #asdf, path = foo.bar})
-readGitRemoteNamespace :: P ReadGitRemoteNamespace
-readGitRemoteNamespace = P.label "generic git repo" $ do
-  C.string "git("
-  protocol <- parseGitProtocol
-  treeish <- P.optional gitTreeishSuffix
-  let repo = ReadGitRepo {url = printProtocol protocol, ref = treeish}
-  C.string ")"
-  nshashPath <- P.optional namespaceHashPath
-  pure case nshashPath of
-    Nothing -> ReadGitRemoteNamespace {repo, sch = Nothing, path = Path.empty}
-    Just (sch, path) -> ReadGitRemoteNamespace {repo, sch, path}
-
--- >>> P.parseMaybe writeGitRepo "git(/srv/git/project.git)"
--- >>> P.parseMaybe writeGitRepo "git(/srv/git/project.git:branch)"
--- Just (WriteGitRepo {url = "/srv/git/project.git", branch = Nothing})
--- Just (WriteGitRepo {url = "/srv/git/project.git", branch = Just "branch"})
---
--- >>> P.parseMaybe writeGitRepo "git(file:///srv/git/project.git)"
--- >>> P.parseMaybe writeGitRepo "git(file:///srv/git/project.git:branch)"
--- Just (WriteGitRepo {url = "file:///srv/git/project.git", branch = Nothing})
--- Just (WriteGitRepo {url = "file:///srv/git/project.git", branch = Just "branch"})
---
--- >>> P.parseMaybe writeGitRepo "git(https://example.com/gitproject.git)"
--- >>> P.parseMaybe writeGitRepo "git(https://example.com/gitproject.git:base)"
--- Just (WriteGitRepo {url = "https://example.com/gitproject.git", branch = Nothing})
--- Just (WriteGitRepo {url = "https://example.com/gitproject.git", branch = Just "base"})
---
--- >>> P.parseMaybe writeGitRepo "git(ssh://user@server/project.git)"
--- >>> P.parseMaybe writeGitRepo "git(ssh://user@server/project.git:branch)"
--- >>> P.parseMaybe writeGitRepo "git(ssh://server/project.git)"
--- >>> P.parseMaybe writeGitRepo "git(ssh://server/project.git:branch)"
--- Just (WriteGitRepo {url = "ssh://user@server/project.git", branch = Nothing})
--- Just (WriteGitRepo {url = "ssh://user@server/project.git", branch = Just "branch"})
--- Just (WriteGitRepo {url = "ssh://server/project.git", branch = Nothing})
--- Just (WriteGitRepo {url = "ssh://server/project.git", branch = Just "branch"})
---
--- >>> P.parseMaybe writeGitRepo "git(server:project)"
--- >>> P.parseMaybe writeGitRepo "git(user@server:project.git:branch)"
--- Just (WriteGitRepo {url = "server:project", branch = Nothing})
--- Just (WriteGitRepo {url = "user@server:project.git", branch = Just "branch"})
-writeGitRepo :: P WriteGitRepo
-writeGitRepo = P.label "repo root for writing" $ do
-  C.string "git("
-  uri <- parseGitProtocol
-  treeish <- P.optional gitTreeishSuffix
-  C.string ")"
-  pure WriteGitRepo {url = printProtocol uri, branch = treeish}
-
--- | A parser for the deprecated format of git URLs, which may still exist in old GitURL
--- unisonConfigs.
---
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "/srv/git/project.git:.namespace"
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "/srv/git/project.git:branch:.namespace"
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "/srv/git/project.git", branch = Nothing}, path = namespace})
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "/srv/git/project.git", branch = Just "branch"}, path = namespace})
---
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "file:///srv/git/project.git"
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "file:///srv/git/project.git:branch"
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "file:///srv/git/project.git", branch = Nothing}, path = })
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "file:///srv/git/project.git", branch = Just "branch"}, path = })
---
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "https://example.com/gitproject.git"
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "https://example.com/gitproject.git:base"
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "https://example.com/gitproject.git", branch = Nothing}, path = })
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "https://example.com/gitproject.git", branch = Just "base"}, path = })
---
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "ssh://user@server/project.git"
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "ssh://user@server/project.git:branch"
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "ssh://server/project.git"
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "ssh://server/project.git:branch"
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "ssh://user@server/project.git", branch = Nothing}, path = })
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "ssh://user@server/project.git", branch = Just "branch"}, path = })
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "ssh://server/project.git", branch = Nothing}, path = })
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "ssh://server/project.git", branch = Just "branch"}, path = })
---
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "server:project"
--- >>> P.parseMaybe deprecatedWriteGitRemoteNamespace "user@server:project.git:branch"
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "server:project", branch = Nothing}, path = })
--- Just (WriteGitRemoteNamespace {repo = WriteGitRepo {url = "user@server:project.git", branch = Just "branch"}, path = })
-deprecatedWriteGitRemoteNamespace :: P WriteGitRemoteNamespace
-deprecatedWriteGitRemoteNamespace = P.label "generic write repo" $ do
-  repo <- deprecatedWriteGitRepo
-  path <- P.optional (C.char ':' *> absolutePath)
-  pure WriteGitRemoteNamespace {repo, path = fromMaybe Path.empty path}
-  where
-    deprecatedWriteGitRepo :: P WriteGitRepo
-    deprecatedWriteGitRepo = do
-      P.label "repo root for writing" $ do
-        uri <- parseGitProtocol
-        treeish <- P.optional deprecatedTreeishSuffix
-        pure WriteGitRepo {url = printProtocol uri, branch = treeish}
-    deprecatedTreeishSuffix :: P Text
-    deprecatedTreeishSuffix = P.label "git treeish" . P.try $ do
-      void $ C.char ':'
-      notdothash <- P.noneOf @[] ".#:"
-      rest <- P.takeWhileP (Just "not colon") (/= ':')
-      pure $ Text.cons notdothash rest
-
--- git(myrepo@git.com).foo.bar
-writeGitRemoteNamespace :: P WriteGitRemoteNamespace
-writeGitRemoteNamespace = P.label "generic write repo" $ do
-  repo <- writeGitRepo
-  path <- P.optional absolutePath
-  pure WriteGitRemoteNamespace {repo, path = fromMaybe Path.empty path}
-
-data GitProtocol
-  = HttpsProtocol (Maybe User) HostInfo UrlPath
-  | SshProtocol (Maybe User) HostInfo UrlPath
-  | ScpProtocol (Maybe User) Host UrlPath
-  | FileProtocol UrlPath
-  | LocalProtocol UrlPath
-  deriving (Eq, Ord, Show)
-
-printProtocol :: GitProtocol -> Text
--- printProtocol x | traceShow x False = undefined
-printProtocol x = case x of
-  HttpsProtocol muser hostInfo path ->
-    "https://"
-      <> printUser muser
-      <> printHostInfo hostInfo
-      <> path
-  SshProtocol muser hostInfo path ->
-    "ssh://"
-      <> printUser muser
-      <> printHostInfo hostInfo
-      <> path
-  ScpProtocol muser host path -> printUser muser <> host <> ":" <> path
-  FileProtocol path -> "file://" <> path
-  LocalProtocol path -> path
-  where
-    printUser = maybe mempty (\(User u) -> u <> "@")
-    printHostInfo :: HostInfo -> Text
-    printHostInfo (HostInfo hostname mport) =
-      hostname <> maybe mempty (Text.cons ':') mport
-
 data Scheme = Ssh | Https
   deriving (Eq, Ord, Show)
 
 data User = User Text
   deriving (Eq, Ord, Show)
 
-type UrlPath = Text
-
 data HostInfo = HostInfo Text (Maybe Text)
   deriving (Eq, Ord, Show)
 
-type Host = Text -- no port
-
--- doesn't yet handle basic authentication like https://user:pass@server.com
--- (does anyone even want that?)
--- or handle ipv6 addresses (https://en.wikipedia.org/wiki/IPv6#Addressing)
-parseGitProtocol :: P GitProtocol
-parseGitProtocol =
-  P.label "parseGitProtocol" $
-    fileRepo <|> httpsRepo <|> sshRepo <|> scpRepo <|> localRepo
-  where
-    localRepo, fileRepo, httpsRepo, sshRepo, scpRepo :: P GitProtocol
-    parsePath =
-      P.takeWhile1P
-        (Just "repo path character")
-        (\c -> not (isSpace c || c == ':' || c == ')'))
-    localRepo = LocalProtocol <$> parsePath
-    fileRepo = P.label "fileRepo" $ do
-      void $ C.string "file://"
-      FileProtocol <$> parsePath
-    httpsRepo = P.label "httpsRepo" $ do
-      void $ C.string "https://"
-      HttpsProtocol <$> P.optional userInfo <*> parseHostInfo <*> parsePath
-    sshRepo = P.label "sshRepo" $ do
-      void $ C.string "ssh://"
-      SshProtocol <$> P.optional userInfo <*> parseHostInfo <*> parsePath
-    scpRepo =
-      P.label "scpRepo" . P.try $
-        ScpProtocol <$> P.optional userInfo <*> parseHost <* C.string ":" <*> parsePath
-    userInfo :: P User
-    userInfo = P.label "userInfo" . P.try $ do
-      username <- P.takeWhile1P (Just "username character") (/= '@')
-      void $ C.char '@'
-      pure $ User username
-    parseHostInfo :: P HostInfo
-    parseHostInfo =
-      P.label "parseHostInfo" $
-        HostInfo
-          <$> parseHost
-          <*> ( P.optional $ do
-                  void $ C.char ':'
-                  P.takeWhile1P (Just "digits") isDigit
-              )
-
-    parseHost = P.label "parseHost" $ hostname <|> ipv4 -- <|> ipv6
-      where
-        hostname =
-          P.takeWhile1P
-            (Just "hostname character")
-            (\c -> isAlphaNum c || c == '.' || c == '-')
-        ipv4 = P.label "ipv4 address" $ do
-          o1 <- decOctet
-          void $ C.char '.'
-          o2 <- decOctet
-          void $ C.char '.'
-          o3 <- decOctet
-          void $ C.char '.'
-          o4 <- decOctet
-          pure $ Text.pack $ o1 <> "." <> o2 <> "." <> o3 <> "." <> o4
-        decOctet = P.count' 1 3 C.digitChar
-
--- >>> P.parseMaybe namespaceHashPath "#nshashabc.path.foo.bar"
--- Just (Just #nshashabc,path.foo.bar)
---
--- >>> P.parseMaybe namespaceHashPath ".path.foo.bar"
--- Just (Nothing,path.foo.bar)
---
--- >>> P.parseMaybe namespaceHashPath "#nshashabc"
--- Just (Just #nshashabc,)
---
--- >>> P.parseMaybe namespaceHashPath "#nshashabc."
--- Just (Just #nshashabc,)
---
--- >>> P.parseMaybe namespaceHashPath "."
--- Just (Nothing,)
-namespaceHashPath :: P (Maybe ShortCausalHash, Path)
-namespaceHashPath = do
-  sch <- P.optional shortCausalHash
-  p <- P.optional absolutePath
-  pure (sch, fromMaybe Path.empty p)
-
--- >>> P.parseMaybe absolutePath "."
--- Just
---
--- >>> P.parseMaybe absolutePath ".path.foo.bar"
--- Just path.foo.bar
-absolutePath :: P Path
-absolutePath = do
-  void $ C.char '.'
-  Path . Seq.fromList <$> P.sepBy nameSegment (C.char '.')
-
 nameSegment :: P NameSegment
 nameSegment =
   NameSegment.unsafeParseText . Text.pack
@@ -384,14 +114,3 @@ nameSegment =
             <$> P.satisfy Unison.Syntax.Lexer.wordyIdStartChar
             <*> P.many (P.satisfy Unison.Syntax.Lexer.wordyIdChar)
         )
-
-gitTreeishSuffix :: P Text
-gitTreeishSuffix = P.label "git treeish" . P.try $ do
-  void $ C.char ':'
-  P.takeWhile1P (Just "not close paren") (/= ')')
-
-shortCausalHash :: P ShortCausalHash
-shortCausalHash = P.label "short causal hash" $ do
-  void $ C.char '#'
-  ShortCausalHash
-    <$> P.takeWhile1P (Just "base32hex chars") (`elem` Base32Hex.validChars)

unison-cli/src/Unison/CommandLine.hs

@@ -46,6 +46,7 @@ import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch (Branch0)
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Editor.Input (Event (..), Input (..))
+import Unison.Codebase.Editor.Output (NumberedArgs)
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Watch qualified as Watch
 import Unison.CommandLine.FZFResolvers qualified as FZFResolvers
@@ -123,14 +124,14 @@ parseInput ::
   -- | Current path from root
   Path.Absolute ->
   -- | Numbered arguments
-  [String] ->
+  NumberedArgs ->
   -- | Input Pattern Map
   Map String InputPattern ->
   -- | command:arguments
   [String] ->
   -- Returns either an error message or the fully expanded arguments list and parsed input.
   -- If the output is `Nothing`, the user cancelled the input (e.g. ctrl-c)
-  IO (Either (P.Pretty CT.ColorText) (Maybe ([String], Input)))
+  IO (Either (P.Pretty CT.ColorText) (Maybe (InputPattern.Arguments, Input)))
 parseInput codebase currentPath numberedArgs patterns segments = runExceptT do
   let getCurrentBranch0 :: IO (Branch0 IO)
       getCurrentBranch0 = Branch.head <$> Codebase.getBranchAtPath codebase currentPath
@@ -140,16 +141,16 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do
     [] -> throwE ""
     command : args -> case Map.lookup command patterns of
       Just pat@(InputPattern {parse, help}) -> do
-        let expandedNumbers :: [String]
+        let expandedNumbers :: InputPattern.Arguments
             expandedNumbers =
-              foldMap (expandNumber numberedArgs) args
+              foldMap (\arg -> maybe [Left arg] (fmap pure) $ expandNumber numberedArgs arg) args
         lift (fzfResolve codebase projCtx getCurrentBranch0 pat expandedNumbers) >>= \case
           Left (NoFZFResolverForArgumentType _argDesc) -> throwError help
           Left (NoFZFOptions argDesc) -> throwError (noCompletionsMessage argDesc)
           Left FZFCancelled -> pure Nothing
           Right resolvedArgs -> do
             parsedInput <- except . parse $ resolvedArgs
-            pure $ Just (command : resolvedArgs, parsedInput)
+            pure $ Just (Left command : resolvedArgs, parsedInput)
       Nothing ->
         throwE
           . warn
@@ -168,11 +169,9 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do
           ]
 
 -- Expand a numeric argument like `1` or a range like `3-9`
-expandNumber :: [String] -> String -> [String]
-expandNumber numberedArgs s = case expandedNumber of
-  Nothing -> [s]
-  Just nums ->
-    [s | i <- nums, Just s <- [vargs Vector.!? (i - 1)]]
+expandNumber :: NumberedArgs -> String -> Maybe NumberedArgs
+expandNumber numberedArgs s =
+  (\nums -> [arg | i <- nums, Just arg <- [vargs Vector.!? (i - 1)]]) <$> expandedNumber
   where
     vargs = Vector.fromList numberedArgs
     rangeRegex = "([0-9]+)-([0-9]+)" :: String
@@ -193,13 +192,13 @@ data FZFResolveFailure
   | NoFZFOptions Text {- argument description -}
   | FZFCancelled
 
-fzfResolve :: Codebase IO Symbol Ann -> ProjectContext -> (IO (Branch0 IO)) -> InputPattern -> [String] -> IO (Either FZFResolveFailure [String])
+fzfResolve :: Codebase IO Symbol Ann -> ProjectContext -> (IO (Branch0 IO)) -> InputPattern -> InputPattern.Arguments -> IO (Either FZFResolveFailure InputPattern.Arguments)
 fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do
   -- We resolve args in two steps, first we check that all arguments that will require a fzf
   -- resolver have one, and only if so do we prompt the user to actually do a fuzzy search.
   -- Otherwise, we might ask the user to perform a search only to realize we don't have a resolver
   -- for a later arg.
-  argumentResolvers :: [ExceptT FZFResolveFailure IO [String]] <-
+  argumentResolvers :: [ExceptT FZFResolveFailure IO InputPattern.Arguments] <-
     (Align.align (InputPattern.args pat) args)
       & traverse \case
         This (argName, opt, InputPattern.ArgumentType {fzfResolver})
@@ -212,7 +211,7 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do
         These _ arg -> pure $ pure [arg]
   argumentResolvers & foldMapM id
   where
-    fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO [String]
+    fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO InputPattern.Arguments
     fuzzyFillArg opt argDesc InputPattern.FZFResolver {getOptions} = do
       currentBranch <- Branch.withoutTransitiveLibs <$> liftIO getCurrentBranch
       options <- liftIO $ getOptions codebase projCtx currentBranch
@@ -223,8 +222,9 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do
           `whenNothingM` throwError FZFCancelled
       -- If the user triggered the fuzzy finder, but selected nothing, abort the command rather than continuing execution
       -- with no arguments.
-      when (null results) $ throwError FZFCancelled
-      pure (Text.unpack <$> results)
+      if null results
+        then throwError FZFCancelled
+        else pure (Left . Text.unpack <$> results)
 
     multiSelectForOptional :: InputPattern.IsOptional -> Bool
     multiSelectForOptional = \case

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

@@ -4,8 +4,10 @@
 
 module Unison.CommandLine.InputPattern
   ( InputPattern (..),
+    Argument,
     ArgumentType (..),
     ArgumentDescription,
+    Arguments,
     argType,
     FZFResolver (..),
     IsOptional (..),
@@ -25,6 +27,7 @@ import System.Console.Haskeline qualified as Line
 import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
 import Unison.Codebase (Codebase)
 import Unison.Codebase.Editor.Input (Input (..))
+import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
 import Unison.Codebase.Path as Path
 import Unison.CommandLine.FZFResolvers (FZFResolver (..))
 import Unison.Prelude
@@ -44,6 +47,14 @@ data IsOptional
 data Visibility = Hidden | Visible
   deriving (Show, Eq, Ord)
 
+-- | An argument to a command is either a string provided by the user which
+-- needs to be parsed or a numbered argument that doesn’t need to be parsed, as
+-- we’ve preserved its representation (although the numbered argument could
+-- still be of the wrong type, which should result in an error).
+type Argument = Either String StructuredArgument
+
+type Arguments = [Argument]
+
 -- | Argument description
 -- It should fit grammatically into sentences like "I was expecting an argument for the <argDesc>"
 -- e.g. "namespace to merge", "definition to delete", "remote target to push to" etc.
@@ -55,7 +66,7 @@ data InputPattern = InputPattern
     visibility :: Visibility, -- Allow hiding certain commands when debugging or work-in-progress
     args :: [(ArgumentDescription, IsOptional, ArgumentType)],
     help :: P.Pretty CT.ColorText,
-    parse :: [String] -> Either (P.Pretty CT.ColorText) Input
+    parse :: Arguments -> Either (P.Pretty CT.ColorText) Input
   }
 
 data ArgumentType = ArgumentType

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

@@ -33,7 +33,7 @@ import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Editor.HandleInput qualified as HandleInput
 import Unison.Codebase.Editor.Input (Event, Input (..))
-import Unison.Codebase.Editor.Output (Output)
+import Unison.Codebase.Editor.Output (NumberedArgs, Output)
 import Unison.Codebase.Editor.UCMVersion (UCMVersion)
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Runtime qualified as Runtime
@@ -61,7 +61,7 @@ getUserInput ::
   Codebase IO Symbol Ann ->
   AuthenticatedHttpClient ->
   Path.Absolute ->
-  [String] ->
+  NumberedArgs ->
   IO Input
 getUserInput codebase authHTTPClient currentPath numberedArgs =
   Line.runInputT
@@ -113,10 +113,11 @@ getUserInput codebase authHTTPClient currentPath numberedArgs =
                 -- Ctrl-c or some input cancel, re-run the prompt
                 go
               Right (Just (expandedArgs, i)) -> do
-                let expandedArgsStr = unwords expandedArgs
-                when (expandedArgs /= ws) $ do
+                let expandedArgs' = IP.unifyArgument <$> expandedArgs
+                    expandedArgsStr = unwords expandedArgs'
+                when (expandedArgs' /= ws) $ do
                   liftIO . putStrLn $ fullPrompt <> expandedArgsStr
-                Line.modifyHistory $ Line.addHistoryUnlessConsecutiveDupe $ unwords expandedArgs
+                Line.modifyHistory $ Line.addHistoryUnlessConsecutiveDupe $ expandedArgsStr
                 pure i
     settings :: Line.Settings IO
     settings =

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

@@ -6,9 +6,7 @@
 module Unison.CommandLine.OutputMessages where
 
 import Control.Lens hiding (at)
-import Control.Monad.State
 import Control.Monad.State.Strict qualified as State
-import Control.Monad.Writer (Writer, runWriter, tell)
 import Data.ByteString.Lazy qualified as LazyByteString
 import Data.Foldable qualified as Foldable
 import Data.List (stripPrefix)
@@ -37,10 +35,12 @@ import U.Codebase.Branch (NamespaceStats (..))
 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
@@ -61,8 +61,9 @@ import Unison.Codebase.Editor.Output.PushPull qualified as PushPull
 import Unison.Codebase.Editor.RemoteRepo (ShareUserHandle (..), WriteRemoteNamespace (..), WriteShareRemoteNamespace (..))
 import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
 import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult
+import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
+import Unison.Codebase.Editor.StructuredArgument qualified as SA
 import Unison.Codebase.Editor.TodoOutput qualified as TO
-import Unison.Codebase.GitError
 import Unison.Codebase.IntegrityCheck (IntegrityResult (..), prettyPrintIntegrityErrors)
 import Unison.Codebase.Patch (Patch (..))
 import Unison.Codebase.Patch qualified as Patch
@@ -72,11 +73,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.TermEdit qualified as TermEdit
-import Unison.Codebase.Type (GitError (GitCodebaseError, GitProtocolError, GitSqliteCodebaseError))
 import Unison.Codebase.TypeEdit qualified as TypeEdit
 import Unison.CommandLine (bigproblem, note, tip)
 import Unison.CommandLine.FZFResolvers qualified as FZFResolvers
@@ -127,7 +124,6 @@ import Unison.Server.Backend qualified as Backend
 import Unison.Server.SearchResult' qualified as SR'
 import Unison.Share.Sync qualified as Share
 import Unison.Share.Sync.Types (CodeserverTransportError (..))
-import Unison.ShortHash qualified as ShortHash
 import Unison.Sync.Types qualified as Share
 import Unison.Syntax.DeclPrinter qualified as DeclPrinter
 import Unison.Syntax.HashQualified qualified as HQ (toText, unsafeFromVar)
@@ -348,7 +344,7 @@ notifyNumbered = \case
             ]
         branchHashes :: [CausalHash]
         branchHashes = (fst <$> reversedHistory) <> tailHashes
-     in (msg, displayBranchHash <$> branchHashes)
+     in (msg, SA.Namespace <$> branchHashes)
     where
       toSCH :: CausalHash -> ShortCausalHash
       toSCH h = SCH.fromHash schLength h
@@ -404,10 +400,9 @@ notifyNumbered = \case
           ],
       numberedArgsForEndangerments ppeDecl endangerments
     )
-  ListEdits patch ppe -> showListEdits patch ppe
   ListProjects projects ->
     ( P.numberedList (map (prettyProjectName . view #name) projects),
-      map (Text.unpack . into @Text . view #name) projects
+      map (SA.Project . view #name) projects
     )
   ListBranches projectName branches ->
     ( P.columnNHeader
@@ -423,7 +418,9 @@ notifyNumbered = \case
                 ]
                   : map (\branch -> ["", "", prettyRemoteBranchInfo branch]) remoteBranches
         ),
-      map (\(branchName, _) -> Text.unpack (into @Text (ProjectAndBranch projectName branchName))) branches
+      map
+        (SA.ProjectBranch . ProjectAndBranch (pure projectName) . fst)
+        branches
     )
   AmbiguousSwitch project (ProjectAndBranch currentProject branch) ->
     ( P.wrap
@@ -448,8 +445,9 @@ notifyNumbered = \case
               <> switch ["2"]
               <> " to pick one of these."
           ),
-      [ Text.unpack (Text.cons '/' (into @Text branch)),
-        Text.unpack (into @Text (ProjectAndBranch project (UnsafeProjectBranchName "main")))
+      [ SA.ProjectBranch $ ProjectAndBranch Nothing branch,
+        SA.ProjectBranch . ProjectAndBranch (pure project) $
+          UnsafeProjectBranchName "main"
       ]
     )
     where
@@ -478,8 +476,8 @@ notifyNumbered = \case
               <> reset (resetArgs ["2"])
               <> " to pick one of these."
           ),
-      [ Text.unpack (Text.cons '/' (into @Text branch)),
-        Text.unpack (into @Text (show absPath0))
+      [ SA.ProjectBranch $ ProjectAndBranch Nothing branch,
+        SA.AbsolutePath absPath0
       ]
     )
     where
@@ -515,13 +513,13 @@ notifyNumbered = \case
                     newNextNum = nextNum + length unnumberedNames
                  in ( newNextNum,
                       ( nameToNum <> (Map.fromList (zip unnumberedNames [nextNum ..])),
-                        args <> fmap Name.toText unnumberedNames
+                        args <> unnumberedNames
                       )
                     )
             )
             (1, (mempty, mempty))
           & snd
-          & over (_2 . mapped) Text.unpack
+          & over (_2 . mapped) SA.Name
       externalDepsTable :: Map LabeledDependency (Set Name) -> [(P.Pretty P.ColorText, P.Pretty P.ColorText)]
       externalDepsTable = ifoldMap $ \ld dependents ->
         [(prettyLD ld, prettyDependents dependents)]
@@ -550,99 +548,6 @@ undoTip =
       <> IP.makeExample' IP.viewReflog
       <> "to undo this change."
 
-showListEdits :: Patch -> PPE.PrettyPrintEnv -> (P.Pretty P.ColorText, NumberedArgs)
-showListEdits patch ppe =
-  ( P.sepNonEmpty
-      "\n\n"
-      [ if null types
-          then mempty
-          else
-            "Edited Types:"
-              `P.hang` P.column2 typeOutputs,
-        if null terms
-          then mempty
-          else
-            "Edited Terms:"
-              `P.hang` P.column2 termOutputs,
-        if null types && null terms
-          then "This patch is empty."
-          else
-            tip . P.string $
-              "To remove entries from a patch, use "
-                <> IP.deleteTermReplacementCommand
-                <> " or "
-                <> IP.deleteTypeReplacementCommand
-                <> ", as appropriate."
-      ],
-    numberedArgsCol1 <> numberedArgsCol2
-  )
-  where
-    typeOutputs, termOutputs :: [(Pretty, Pretty)]
-    numberedArgsCol1, numberedArgsCol2 :: NumberedArgs
-    -- We use the output of the first column's count as the first number in the second
-    -- column's count. Laziness allows this since they're used independently of one another.
-    (((typeOutputs, termOutputs), (lastNumberInFirstColumn, _)), (numberedArgsCol1, numberedArgsCol2)) =
-      runWriter . flip runStateT (1, lastNumberInFirstColumn) $ do
-        typeOutputs <- traverse prettyTypeEdit types
-        termOutputs <- traverse prettyTermEdit terms
-        pure (typeOutputs, termOutputs)
-    types :: [(Reference, TypeEdit.TypeEdit)]
-    types = R.toList $ Patch._typeEdits patch
-    terms :: [(Reference, TermEdit.TermEdit)]
-    terms = R.toList $ Patch._termEdits patch
-    showNum :: Int -> Pretty
-    showNum n = P.hiBlack (P.shown n <> ". ")
-
-    prettyTermEdit ::
-      (Reference.TermReference, TermEdit.TermEdit) ->
-      StateT (Int, Int) (Writer (NumberedArgs, NumberedArgs)) (Pretty, Pretty)
-    prettyTermEdit (lhsRef, termEdit) = do
-      n1 <- gets fst <* modify (first succ)
-      let lhsTermName = PPE.termName ppe (Referent.Ref lhsRef)
-      -- We use the shortHash of the lhs rather than its name for numbered args,
-      -- since its name is likely to be "historical", and won't work if passed to a ucm command.
-      let lhsHash = Text.unpack . ShortHash.toText . Reference.toShortHash $ lhsRef
-      case termEdit of
-        TermEdit.Deprecate -> do
-          lift $ tell ([lhsHash], [])
-          pure
-            ( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTermName),
-              "-> (deprecated)"
-            )
-        TermEdit.Replace rhsRef _typing -> do
-          n2 <- gets snd <* modify (second succ)
-          let rhsTermName = PPE.termName ppe (Referent.Ref rhsRef)
-          lift $ tell ([lhsHash], [Text.unpack (HQ.toText rhsTermName)])
-          pure
-            ( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTermName),
-              "-> " <> showNum n2 <> (P.syntaxToColor . prettyHashQualified $ rhsTermName)
-            )
-
-    prettyTypeEdit ::
-      (Reference, TypeEdit.TypeEdit) ->
-      StateT (Int, Int) (Writer (NumberedArgs, NumberedArgs)) (Pretty, Pretty)
-    prettyTypeEdit (lhsRef, typeEdit) = do
-      n1 <- gets fst <* modify (first succ)
-      let lhsTypeName = PPE.typeName ppe lhsRef
-      -- We use the shortHash of the lhs rather than its name for numbered args,
-      -- since its name is likely to be "historical", and won't work if passed to a ucm command.
-      let lhsHash = Text.unpack . ShortHash.toText . Reference.toShortHash $ lhsRef
-      case typeEdit of
-        TypeEdit.Deprecate -> do
-          lift $ tell ([lhsHash], [])
-          pure
-            ( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTypeName),
-              "-> (deprecated)"
-            )
-        TypeEdit.Replace rhsRef -> do
-          n2 <- gets snd <* modify (second succ)
-          let rhsTypeName = PPE.typeName ppe rhsRef
-          lift $ tell ([lhsHash], [Text.unpack (HQ.toText rhsTypeName)])
-          pure
-            ( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTypeName),
-              "-> " <> showNum n2 <> (P.syntaxToColor . prettyHashQualified $ rhsTypeName)
-            )
-
 notifyUser :: FilePath -> Output -> IO Pretty
 notifyUser dir = \case
   SaveTermNameConflict name ->
@@ -684,49 +589,6 @@ notifyUser dir = \case
           $ "The namespaces "
             <> P.commas (prettyBranchId <$> ps)
             <> " are empty. Was there a typo?"
-  WarnIncomingRootBranch current hashes ->
-    pure $
-      if null hashes
-        then
-          P.wrap $
-            "Please let someone know I generated an empty IncomingRootBranch"
-              <> " event, which shouldn't be possible!"
-        else
-          P.lines
-            [ P.wrap $
-                (if length hashes == 1 then "A" else "Some")
-                  <> "codebase"
-                  <> P.plural hashes "root"
-                  <> "appeared unexpectedly"
-                  <> "with"
-                  <> P.group (P.plural hashes "hash" <> ":"),
-              "",
-              (P.indentN 2 . P.oxfordCommas)
-                (map prettySCH $ toList hashes),
-              "",
-              P.wrap $
-                "and I'm not sure what to do about it."
-                  <> "The last root namespace hash that I knew about was:",
-              "",
-              P.indentN 2 $ prettySCH current,
-              "",
-              P.wrap $ "Now might be a good time to make a backup of your codebase. 😬",
-              "",
-              P.wrap $
-                "After that, you might try using the"
-                  <> makeExample' IP.forkLocal
-                  <> "command to inspect the namespaces listed above, and decide which"
-                  <> "one you want as your root."
-                  <> "You can also use"
-                  <> makeExample' IP.viewReflog
-                  <> "to see the"
-                  <> "last few root namespace hashes on record.",
-              "",
-              P.wrap $
-                "Once you find one you like, you can use the"
-                  <> makeExample' IP.resetRoot
-                  <> "command to set it."
-            ]
   LoadPullRequest baseNS headNS basePath headPath mergedPath squashedPath ->
     pure $
       P.lines
@@ -824,13 +686,6 @@ notifyUser dir = \case
             <> " by someone else. Trying your command again might fix it."
       ]
   EvaluationFailure err -> pure err
-  TypeTermMismatch typeName termName ->
-    pure $
-      P.warnCallout "I was expecting either two types or two terms but was given a type "
-        <> P.syntaxToColor (prettyHashQualified typeName)
-        <> " and a term "
-        <> P.syntaxToColor (prettyHashQualified termName)
-        <> "."
   SearchTermsNotFound hqs | null hqs -> pure mempty
   SearchTermsNotFound hqs ->
     pure $
@@ -856,8 +711,6 @@ notifyUser dir = \case
           P.warnCallout typeOrTermMsg
             <> P.newline
             <> P.syntaxToColor (P.indent "  " (P.lines (prettyHashQualified <$> otherHits)))
-  PatchNotFound _ ->
-    pure . P.warnCallout $ "I don't know about that patch."
   NameNotFound _ ->
     pure . P.warnCallout $ "I don't know about that name."
   NamesNotFound hqs ->
@@ -875,8 +728,6 @@ notifyUser dir = \case
     pure . P.warnCallout $ "A term by that name already exists."
   TypeAlreadyExists _ _ ->
     pure . P.warnCallout $ "A type by that name already exists."
-  PatchAlreadyExists _ ->
-    pure . P.warnCallout $ "A patch by that name already exists."
   BranchEmpty b ->
     pure . P.warnCallout . P.wrap $
       P.group (prettyWhichBranchEmpty b) <> "is an empty namespace."
@@ -888,21 +739,21 @@ notifyUser dir = \case
       P.lines
         [ P.wrap $
             "I looked for a function"
-              <> P.backticked (P.text main)
+              <> P.backticked (P.text $ HQ.toText main)
               <> "in the most recently typechecked file and codebase but couldn't find one. It has to have the type:",
           "",
-          P.indentN 2 $ P.lines [P.text main <> " : " <> TypePrinter.pretty ppe t | t <- ts]
+          P.indentN 2 $ P.lines [P.text (HQ.toText main) <> " : " <> TypePrinter.pretty ppe t | t <- ts]
         ]
   BadMainFunction what main ty ppe ts ->
     pure . P.callout "😶" $
       P.lines
         [ P.string "I found this function:",
           "",
-          P.indentN 2 $ P.text main <> " : " <> TypePrinter.pretty ppe ty,
+          P.indentN 2 $ P.text (HQ.toText main) <> " : " <> TypePrinter.pretty ppe ty,
           "",
           P.wrap $ P.string "but in order for me to" <> P.backticked (P.text what) <> "it needs to be a subtype of:",
           "",
-          P.indentN 2 $ P.lines [P.text main <> " : " <> TypePrinter.pretty ppe t | t <- ts]
+          P.indentN 2 $ P.lines [P.text (HQ.toText main) <> " : " <> TypePrinter.pretty ppe t | t <- ts]
         ]
   NoUnisonFile -> do
     dir' <- canonicalizePath dir
@@ -1187,8 +1038,6 @@ notifyUser dir = \case
   LoadingFile sourceName -> do
     fileName <- renderFileName $ Text.unpack sourceName
     pure $ P.wrap $ "Loading changes detected in " <> P.group (fileName <> ".")
-  -- TODO: Present conflicting TermEdits and TypeEdits
-  -- if we ever allow users to edit hashes directly.
   Typechecked sourceName ppe slurpResult uf -> do
     let fileStatusMsg = SlurpResult.pretty False ppe slurpResult
     let containsWatchExpressions = notNull $ UF.watchComponents uf
@@ -1221,8 +1070,7 @@ notifyUser dir = \case
                                 <> IP.makeExample' IP.add
                                 <> " or "
                                 <> P.group (IP.makeExample' IP.update <> ",")
-                                <> "here's how your codebase would"
-                                <> "change:",
+                                <> "here's how your codebase would change:",
                             P.indentN 2 $ SlurpResult.pretty False ppe slurpResult
                           ]
               ]
@@ -1242,133 +1090,6 @@ notifyUser dir = \case
             pure . P.wrap $
               "I loaded " <> P.text sourceName <> " and didn't find anything."
           else pure mempty
-  GitError e -> pure $ case e of
-    GitSqliteCodebaseError e -> case e of
-      CodebaseFileLockFailed ->
-        P.wrap $
-          "It looks to me like another ucm process is using this codebase. Only one ucm process can use a codebase at a time."
-      NoDatabaseFile repo localPath ->
-        P.wrap $
-          "I didn't find a codebase in the repository at"
-            <> prettyReadGitRepo repo
-            <> "in the cache directory at"
-            <> P.backticked' (P.string localPath) "."
-      CodebaseRequiresMigration (SchemaVersion fromSv) (SchemaVersion toSv) -> do
-        P.wrap $
-          "The specified codebase codebase is on version "
-            <> P.shown fromSv
-            <> " but needs to be on version "
-            <> P.shown toSv
-      UnrecognizedSchemaVersion repo localPath (SchemaVersion v) ->
-        P.wrap $
-          "I don't know how to interpret schema version "
-            <> P.shown v
-            <> "in the repository at"
-            <> prettyReadGitRepo repo
-            <> "in the cache directory at"
-            <> P.backticked' (P.string localPath) "."
-      GitCouldntParseRootBranchHash repo s ->
-        P.wrap $
-          "I couldn't parse the string"
-            <> P.red (P.string s)
-            <> "into a namespace hash, when opening the repository at"
-            <> P.group (prettyReadGitRepo repo <> ".")
-    GitProtocolError e -> case e of
-      NoGit ->
-        P.wrap $
-          "I couldn't find git. Make sure it's installed and on your path."
-      CleanupError e ->
-        P.wrap $
-          "I encountered an exception while trying to clean up a git cache directory:"
-            <> P.group (P.shown e)
-      CloneException repo msg ->
-        P.wrap $
-          "I couldn't clone the repository at"
-            <> prettyReadGitRepo repo
-            <> ";"
-            <> "the error was:"
-            <> (P.indentNAfterNewline 2 . P.group . P.string) msg
-      CopyException srcRepoPath destPath msg ->
-        P.wrap $
-          "I couldn't copy the repository at"
-            <> P.string srcRepoPath
-            <> "into"
-            <> P.string destPath
-            <> ";"
-            <> "the error was:"
-            <> (P.indentNAfterNewline 2 . P.group . P.string) msg
-      PushNoOp repo ->
-        P.wrap $
-          "The repository at" <> prettyWriteGitRepo repo <> "is already up-to-date."
-      PushException repo msg ->
-        P.wrap $
-          "I couldn't push to the repository at"
-            <> prettyWriteGitRepo repo
-            <> ";"
-            <> "the error was:"
-            <> (P.indentNAfterNewline 2 . P.group . P.string) msg
-      RemoteRefNotFound repo ref ->
-        P.wrap $
-          "I couldn't find the ref " <> P.green (P.text ref) <> " in the repository at " <> P.blue (P.text repo) <> ";"
-      UnrecognizableCacheDir uri localPath ->
-        P.wrap $
-          "A cache directory for"
-            <> P.backticked (P.text $ RemoteRepo.printReadGitRepo uri)
-            <> "already exists at"
-            <> P.backticked' (P.string localPath) ","
-            <> "but it doesn't seem to"
-            <> "be a git repository, so I'm not sure what to do next.  Delete it?"
-      UnrecognizableCheckoutDir uri localPath ->
-        P.wrap $
-          "I tried to clone"
-            <> P.backticked (P.text $ RemoteRepo.printReadGitRepo uri)
-            <> "into a cache directory at"
-            <> P.backticked' (P.string localPath) ","
-            <> "but I can't recognize the"
-            <> "result as a git repository, so I'm not sure what to do next."
-      PushDestinationHasNewStuff repo ->
-        P.callout "⏸" . P.lines $
-          [ P.wrap $
-              "The repository at"
-                <> prettyWriteGitRepo repo
-                <> "has some changes I don't know about.",
-            "",
-            P.wrap $ "Try" <> pull <> "to merge these changes locally, then" <> push <> "again."
-          ]
-        where
-          push = P.group . P.backticked . IP.patternName $ IP.push
-          pull = P.group . P.backticked . IP.patternName $ IP.pull
-    GitCodebaseError e -> case e of
-      CouldntFindRemoteBranch repo path ->
-        P.wrap $
-          "I couldn't find the remote branch at"
-            <> P.shown path
-            <> "in the repository at"
-            <> prettyReadGitRepo repo
-      NoRemoteNamespaceWithHash repo sch ->
-        P.wrap $
-          "The repository at"
-            <> prettyReadGitRepo repo
-            <> "doesn't contain a namespace with the hash prefix"
-            <> (P.blue . P.text . SCH.toText) sch
-      RemoteNamespaceHashAmbiguous repo sch hashes ->
-        P.lines
-          [ P.wrap $
-              "The namespace hash"
-                <> prettySCH sch
-                <> "at"
-                <> prettyReadGitRepo repo
-                <> "is ambiguous."
-                <> "Did you mean one of these hashes?",
-            "",
-            P.indentN 2 $
-              P.lines
-                ( prettySCH . SCH.fromHash ((Text.length . SCH.toText) sch * 2)
-                    <$> Set.toList hashes
-                ),
-            "",
-            P.wrap "Try again with a few more hash characters to disambiguate."
-          ]
   BustedBuiltins (Set.toList -> new) (Set.toList -> old) ->
     -- todo: this could be prettier!  Have a nice list like `find` gives, but
     -- that requires querying the codebase to determine term types.  Probably
@@ -1398,17 +1119,6 @@ notifyUser dir = \case
             "You're missing:" `P.hang` P.lines (fmap (P.text . Reference.toText) new),
             "I'm missing:" `P.hang` P.lines (fmap (P.text . Reference.toText) old)
           ]
-  ListOfPatches patches ->
-    pure $
-      if null patches
-        then P.lit "nothing to show"
-        else numberedPatches patches
-    where
-      numberedPatches :: Set Name -> Pretty
-      numberedPatches patches =
-        (P.column2 . fmap format) ([(1 :: Integer) ..] `zip` (toList patches))
-        where
-          format (i, p) = (P.hiBlack . fromString $ show i <> ".", prettyName p)
   NoConfiguredRemoteMapping pp p -> do
     let (localPathExample, sharePathExample) =
           if Path.isRoot p
@@ -1428,7 +1138,7 @@ notifyUser dir = \case
           "Type `help " <> PushPull.fold "push" "pull" pp <> "` for more information."
         ]
 
-  --  | ConfiguredGitUrlParseError PushPull Path' Text String
+  --  | ConfiguredRemoteMappingParseError PushPull Path' Text String
   ConfiguredRemoteMappingParseError pp p url err ->
     pure . P.fatalCallout . P.lines $
       [ P.wrap $
@@ -1542,12 +1252,6 @@ notifyUser dir = \case
       "I could't find a type with hash "
         <> (prettyShortHash sh)
   AboutToPropagatePatch -> pure "Applying changes from patch..."
-  NothingToPatch _patchPath dest ->
-    pure $
-      P.callout "😶" . P.wrap $
-        "This had no effect. Perhaps the patch has already been applied"
-          <> "or it doesn't intersect with the definitions in"
-          <> P.group (prettyPath' dest <> ".")
   PatchNeedsToBeConflictFree ->
     pure . P.wrap $
       "I tried to auto-apply the patch, but couldn't because it contained"
@@ -1605,35 +1309,75 @@ 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 ->
-    pure . P.wrap $
-      "On"
-        <> P.group (prettyProjectBranchName branch <> ",")
-        <> prettyName name1
-        <> "and"
-        <> prettyName name2
-        <> "are not aliases, but they used to be."
+          <> 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 "Sorry, I wasn't able to perform the merge:"
+        <> P.newline
+        <> P.newline
+        <> P.wrap
+          ( "On the merge ancestor,"
+              <> prettyName name1
+              <> "and"
+              <> prettyName name2
+              <> "were aliases for the same definition, but on"
+              <> prettyMergeSourceOrTarget aliceOrBob
+              <> "the names have different definitions currently. I'd need just a single new definition to use in their"
+              <> "dependents when I merge."
+          )
+        <> P.newline
+        <> P.newline
+        <> P.wrap ("Please fix up" <> prettyMergeSourceOrTarget aliceOrBob <> "to resolve this. For example,")
+        <> P.newline
+        <> P.newline
+        <> P.indentN
+          2
+          ( P.bulleted
+              [ P.wrap
+                  ( IP.makeExample' IP.update
+                      <> "the definitions to be the same again, so that there's nothing for me to decide."
+                  ),
+                P.wrap
+                  ( IP.makeExample' IP.moveAll
+                      <> "or"
+                      <> IP.makeExample' IP.delete
+                      <> "all but one of the definitions; I'll use the remaining name when propagating updates."
+                  )
+              ]
+          )
+        <> P.newline
+        <> P.newline
+        <> P.wrap "and then try merging again."
   MergeConflictedTermName name _refs ->
     pure . P.wrap $
       "The term name" <> prettyName name <> "is ambiguous. Please resolve the ambiguity before merging."
@@ -1641,49 +1385,101 @@ notifyUser dir = \case
     pure . P.wrap $
       "The type name" <> prettyName name <> "is ambiguous. Please resolve the ambiguity before merging."
   MergeConflictInvolvingBuiltin name ->
-    pure . P.wrap $
-      "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 ->
+    pure . P.lines $
+      [ P.wrap "Sorry, I wasn't able to perform the merge:",
+        "",
+        P.wrap
+          ( "There's a merge conflict on"
+              <> P.group (prettyName name <> ",")
+              <> "but it's a builtin on one or both branches. I can't yet handle merge conflicts involving builtins."
+          ),
+        "",
+        P.wrap
+          ( "Please eliminate this conflict by updating one branch or the other, making"
+              <> prettyName name
+              <> "the same on both branches, or making neither of them a builtin, and then try the merge again."
+          )
+      ]
+  MergeConstructorAlias aliceOrBob typeName conName1 conName2 ->
+    pure . P.lines $
+      [ P.wrap "Sorry, I wasn't able to perform the merge:",
+        "",
+        P.wrap $
+          "On"
+            <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
+            <> "the type"
+            <> prettyName typeName
+            <> "has a constructor with multiple names, and I can't perform a merge in this situation:",
+        "",
+        P.indentN 2 (P.bulleted [prettyName conName1, prettyName conName2]),
+        "",
+        P.wrap "Please delete all but one name for each constructor, and then try merging again."
+      ]
+  MergeDefnsInLib aliceOrBob ->
+    pure . P.lines $
+      [ P.wrap "Sorry, I wasn't able to perform the merge:",
+        "",
+        P.wrap $
+          "On"
+            <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
+            <> "there's a type or term at the top level of the `lib` namespace, where I only expect to find"
+            <> "subnamespaces representing library dependencies.",
+        "",
+        P.wrap "Please move or remove it and then try merging again."
+      ]
+  MergeMissingConstructorName aliceOrBob name ->
+    pure . P.lines $
+      [ P.wrap "Sorry, I wasn't able to perform the merge:",
+        "",
+        P.wrap $
+          "On"
+            <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
+            <> "the type"
+            <> prettyName name
+            <> "has some constructors with missing names, and I can't perform a merge in this situation.",
+        "",
+        P.wrap $
+          "You can use"
+            <> IP.makeExample IP.view [prettyName name]
+            <> "and"
+            <> IP.makeExample IP.aliasTerm ["<hash>", prettyName name <> ".<ConstructorName>"]
+            <> "to give names to each unnamed constructor, and then try the merge again."
+      ]
+  MergeNestedDeclAlias aliceOrBob shorterName longerName ->
     pure . P.wrap $
       "On"
-        <> case maybeBranch of
-          Nothing -> "the LCA,"
-          Just branch -> P.group (prettyProjectBranchName branch <> ",")
-        <> prettyName name1
-        <> "and"
-        <> prettyName name2
-        <> "are aliases. Every type declaration must have exactly one name for each constructor."
-  MergeDefnsInLib ->
-    pure . P.wrap $
-      "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 ->
-    pure . P.wrap $
-      "The type"
-        <> prettyName name
-        <> "is missing a name for one of its constructors. Please add one before merging."
-  MergeNestedDeclAlias shorterName longerName ->
-    pure . P.wrap $
-      "The type"
+        <> 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 ->
-    pure . P.wrap $
-      "The constructor"
-        <> prettyName name
-        <> "is not in a subnamespace of a name of its type."
-        <> "Please either delete it or rename it before merging."
+        <> "I'm not able to perform a merge when a type exists nested under an alias of itself. Please separate them or"
+        <> "delete one copy, and then try merging again."
+  MergeStrayConstructor aliceOrBob name ->
+    pure . P.lines $
+      [ P.wrap $
+          "Sorry, I wasn't able to perform the merge, because I need all constructor names to be nested somewhere"
+            <> "beneath the corresponding type name.",
+        "",
+        P.wrap $
+          "On"
+            <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
+            <> "the constructor"
+            <> prettyName name
+            <> "is not nested beneath the corresponding type name. Please either use"
+            <> IP.makeExample' IP.moveAll
+            <> "to move it, or if it's an extra copy, you can simply"
+            <> IP.makeExample' IP.delete
+            <> "it. Then try the merge again."
+      ]
   PreviewMergeAlreadyUpToDate src dest ->
     pure . P.callout "😶" $
       P.wrap $
         prettyNamespaceKey dest
           <> "is already up-to-date with"
           <> P.group (prettyNamespaceKey src <> ".")
-  DumpNumberedArgs args -> pure . P.numberedList $ fmap P.string args
+  DumpNumberedArgs schLength args ->
+    pure . P.numberedList $ fmap (P.text . IP.formatStructuredArgument (pure schLength)) args
   NoConflictsOrEdits ->
     pure (P.okCallout "No conflicts or edits in progress.")
   HelpMessage pat -> pure $ IP.showPatternHelp pat
@@ -1805,7 +1601,7 @@ notifyUser dir = \case
   ShareError shareError -> pure (prettyShareError shareError)
   ViewOnShare shareRef ->
     pure $
-      "View it on Unison Share: " <> case shareRef of
+      "View it here: " <> case shareRef of
         Left repoPath -> prettyShareLink repoPath
         Right branchInfo -> prettyRemoteBranchInfo branchInfo
   IntegrityCheck result -> pure $ case result of
@@ -1931,12 +1727,17 @@ notifyUser dir = \case
       "I just created"
         <> prettyProjectName projectName
         <> "on"
-        <> prettyURI host
+        <> prettyShareURI host
   CreatedRemoteProjectBranch host projectAndBranch ->
     pure . P.wrap $
-      "I just created" <> prettyProjectAndBranchName projectAndBranch <> "on" <> prettyURI host
+      "I just created" <> prettyProjectAndBranchName projectAndBranch <> "on" <> prettyShareURI host
   RemoteProjectBranchIsUpToDate host projectAndBranch ->
-    pure (P.wrap (prettyProjectAndBranchName projectAndBranch <> "on" <> prettyURI host <> "is already up-to-date."))
+    pure $
+      P.wrap $
+        prettyProjectAndBranchName projectAndBranch
+          <> "on"
+          <> prettyShareURI host
+          <> "is already up-to-date."
   InvalidProjectName name -> pure (P.wrap (P.text name <> "is not a valid project name."))
   InvalidProjectBranchName name -> pure (P.wrap (P.text name <> "is not a valid branch name."))
   ProjectNameAlreadyExists name ->
@@ -1956,12 +1757,12 @@ notifyUser dir = \case
   NotOnProjectBranch -> pure (P.wrap "You are not currently on a branch.")
   NoAssociatedRemoteProject host projectAndBranch ->
     pure . P.wrap $
-      prettyProjectAndBranchName projectAndBranch <> "isn't associated with any project on" <> prettyURI host
+      prettyProjectAndBranchName projectAndBranch <> "isn't associated with any project on" <> prettyShareURI host
   NoAssociatedRemoteProjectBranch host (ProjectAndBranch project branch) ->
     pure . P.wrap $
       prettyProjectAndBranchName (ProjectAndBranch (project ^. #name) (branch ^. #name))
         <> "isn't associated with any branch on"
-        <> prettyURI host
+        <> prettyShareURI host
   LocalProjectDoesntExist project ->
     pure . P.wrap $
       prettyProjectName project <> "does not exist."
@@ -1977,17 +1778,17 @@ notifyUser dir = \case
         <> "exists."
   RemoteProjectDoesntExist host project ->
     pure . P.wrap $
-      prettyProjectName project <> "does not exist on" <> prettyURI host
+      prettyProjectName project <> "does not exist on" <> prettyShareURI host
   RemoteProjectBranchDoesntExist host projectAndBranch ->
     pure . P.wrap $
-      prettyProjectAndBranchName projectAndBranch <> "does not exist on" <> prettyURI host
+      prettyProjectAndBranchName projectAndBranch <> "does not exist on" <> prettyShareURI host
   RemoteProjectBranchDoesntExist'Push host projectAndBranch ->
     let push = P.group . P.backticked . IP.patternName $ IP.push
      in pure . P.wrap $
           "The previous push target named"
             <> prettyProjectAndBranchName projectAndBranch
             <> "has been deleted from"
-            <> P.group (prettyURI host <> ".")
+            <> P.group (prettyShareURI host <> ".")
             <> "I've deleted the invalid push target."
             <> "Run the"
             <> push
@@ -1996,14 +1797,14 @@ notifyUser dir = \case
     pure . P.wrap $
       prettyProjectAndBranchName projectAndBranch
         <> "on"
-        <> prettyURI host
+        <> prettyShareURI host
         <> "has some history that I don't know about."
   RemoteProjectPublishedReleaseCannotBeChanged host projectAndBranch ->
     pure . P.wrap $
       "The release"
         <> prettyProjectAndBranchName projectAndBranch
         <> "on"
-        <> prettyURI host
+        <> prettyShareURI host
         <> "has already been published and cannot be changed."
         <> "Consider making a new release instead."
   RemoteProjectReleaseIsDeprecated host projectAndBranch ->
@@ -2011,7 +1812,7 @@ notifyUser dir = \case
       "The release"
         <> prettyProjectAndBranchName projectAndBranch
         <> "on"
-        <> prettyURI host
+        <> prettyShareURI host
         <> "has been deprecated."
   Unauthorized message ->
     pure . P.wrap $
@@ -2260,32 +2061,34 @@ 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"
         <> prettyProjectAndBranchName libdep
         <> "as"
         <> P.group (P.text (NameSegment.toEscapedText segment) <> ".")
+  NoUpgradeInProgress ->
+    pure . P.wrap $ "It doesn't look like there's an upgrade in progress."
 
 expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty
 expectedEmptyPushDest namespace =
@@ -2770,7 +2573,7 @@ renderNameConflicts ppe conflictedNames = do
       P.lines <$> do
         for (Map.toList conflictedNames) $ \(name, hashes) -> do
           prettyConflicts <- for hashes \hash -> do
-            n <- addNumberedArg (Text.unpack (HQ.toText hash))
+            n <- addNumberedArg $ SA.HashQualified hash
             pure $ formatNum n <> (P.blue . P.syntaxToColor . prettyHashQualified $ hash)
           pure . P.wrap $
             ( "The "
@@ -2802,7 +2605,7 @@ renderEditConflicts ppe Patch {..} = do
         <> (fmap Right . Map.toList . R.toMultimap . R.filterManyDom $ _termEdits)
     numberedHQName :: HQ.HashQualified Name -> Numbered Pretty
     numberedHQName hqName = do
-      n <- addNumberedArg (Text.unpack (HQ.toText hqName))
+      n <- addNumberedArg $ SA.HashQualified hqName
       pure $ formatNum n <> styleHashQualified P.bold hqName
     formatTypeEdits ::
       (Reference, Set TypeEdit.TypeEdit) ->
@@ -2841,9 +2644,9 @@ renderEditConflicts ppe Patch {..} = do
       Numbered Pretty
     formatConflict = either formatTypeEdits formatTermEdits
 
-type Numbered = State.State (Int, Seq.Seq String)
+type Numbered = State.State (Int, Seq.Seq StructuredArgument)
 
-addNumberedArg :: String -> Numbered Int
+addNumberedArg :: StructuredArgument -> Numbered Int
 addNumberedArg s = do
   (n, args) <- State.get
   State.put (n + 1, args Seq.|> s)
@@ -2915,11 +2718,11 @@ todoOutput ppe todo = runNumbered do
     todoEdits :: Numbered Pretty
     todoEdits = do
       numberedTypes <- for (unscore <$> dirtyTypes) \(ref, displayObj) -> do
-        n <- addNumberedArg (Text.unpack (HQ.toText $ PPE.typeName ppeu ref))
+        n <- addNumberedArg . SA.HashQualified $ PPE.typeName ppeu ref
         pure $ formatNum n <> prettyDeclPair ppeu (ref, displayObj)
       let filteredTerms = goodTerms (unscore <$> dirtyTerms)
       termNumbers <- for filteredTerms \(ref, _, _) -> do
-        n <- addNumberedArg (Text.unpack (HQ.toText $ PPE.termName ppeu ref))
+        n <- addNumberedArg . SA.HashQualified $ PPE.termName ppeu ref
         pure $ formatNum n
       let formattedTerms = TypePrinter.prettySignaturesCT ppes filteredTerms
           numberedTerms = zipWith (<>) termNumbers formattedTerms
@@ -3324,21 +3127,13 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} =
     -- DeclPrinter.prettyDeclHeader : HQ -> Either
     numPatch :: Input.AbsBranchId -> Name -> Numbered Pretty
     numPatch prefix name =
-      addNumberedArg' $ prefixBranchId prefix name
+      addNumberedArg' $ SA.NameWithBranchPrefix prefix name
 
     numHQ' :: Input.AbsBranchId -> HQ'.HashQualified Name -> Referent -> Numbered Pretty
     numHQ' prefix hq r =
-      addNumberedArg' . HQ'.toStringWith (prefixBranchId prefix) . HQ'.requalify hq $ r
+      addNumberedArg' . SA.HashQualifiedWithBranchPrefix prefix $ HQ'.requalify hq r
 
-    -- E.g.
-    -- prefixBranchId "#abcdef" "base.List.map" -> "#abcdef.base.List.map"
-    -- prefixBranchId ".base" "List.map" -> ".base.List.map"
-    prefixBranchId :: Input.AbsBranchId -> Name -> String
-    prefixBranchId branchId name = case branchId of
-      Left sch -> "#" <> SCH.toString sch <> ":" <> Text.unpack (Name.toText (Name.makeAbsolute name))
-      Right pathPrefix -> Text.unpack (Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name))
-
-    addNumberedArg' :: String -> Numbered Pretty
+    addNumberedArg' :: StructuredArgument -> Numbered Pretty
     addNumberedArg' s = case sn of
       ShowNumbers -> do
         n <- addNumberedArg s
@@ -3593,7 +3388,7 @@ numberedArgsForEndangerments (PPED.unsuffixifiedPPE -> ppe) m =
   m
     & Map.elems
     & concatMap toList
-    & fmap (Text.unpack . HQ.toText . PPE.labeledRefName ppe)
+    & fmap (SA.HashQualified . PPE.labeledRefName ppe)
 
 -- | Format and render all dependents which are endangered by references going extinct.
 endangeredDependentsTable ::

unison-cli/src/Unison/LSP/Queries.hs

@@ -389,7 +389,7 @@ markdownDocsForFQN fileUri fqn =
     nameSearch <- lift $ getNameSearch
     Env {codebase, runtime} <- ask
     liftIO $ do
-      docRefs <- Backend.docsForDefinitionName codebase nameSearch ExactName name
+      docRefs <- Codebase.runTransaction codebase $ Backend.docsForDefinitionName codebase nameSearch ExactName name
       for docRefs $ \docRef -> do
         Identity (_, _, doc, _evalErrs) <- Backend.renderDocRefs pped (Pretty.Width 80) codebase runtime (Identity docRef)
         pure . Md.toText $ Md.toMarkdown doc

unison-cli/tests/Main.hs

@@ -6,7 +6,6 @@ import System.IO
 import System.IO.CodePage (withCP65001)
 import Unison.Test.ClearCache qualified as ClearCache
 import Unison.Test.Cli.Monad qualified as Cli.Monad
-import Unison.Test.GitSync qualified as GitSync
 import Unison.Test.LSP qualified as LSP
 import Unison.Test.UriParser qualified as UriParser
 
@@ -16,7 +15,6 @@ test =
     [ LSP.test,
       ClearCache.test,
       Cli.Monad.test,
-      GitSync.test,
       UriParser.test
     ]
 

unison-cli/tests/Unison/Test/Cli/Monad.hs

@@ -6,6 +6,8 @@ where
 import Control.Lens
 import EasyTest
 import Unison.Cli.Monad qualified as Cli
+import Unison.Codebase.Editor.StructuredArgument qualified as SA
+import Unison.Syntax.Name qualified as Name
 
 test :: Test ()
 test =
@@ -16,13 +18,15 @@ test =
             Cli.runCli dummyEnv dummyLoopState do
               Cli.label \goto -> do
                 Cli.label \_ -> do
-                  Cli.setNumberedArgs ["foo"]
+                  Cli.setNumberedArgs [SA.Name $ Name.unsafeParseText "foo"]
                   goto (1 :: Int)
                 pure 2
         -- test that 'goto' short-circuits, as expected
         expectEqual' (Cli.Success 1) r
         -- test that calling 'goto' doesn't lose state changes made along the way
-        expectEqual' ["foo"] (state ^. #numberedArgs)
+        expectEqual'
+          [SA.Name $ Name.unsafeParseText "foo"]
+          (state ^. #numberedArgs)
         ok
     ]
 

unison-cli/tests/Unison/Test/GitSync.hs

@@ -1,732 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Unison.Test.GitSync where
-
-import Data.Maybe (fromJust)
-import Data.String.Here.Interpolated (i)
-import Data.Text qualified as Text
-import EasyTest
-import Shellmet ()
-import System.Directory (removePathForcibly)
-import System.FilePath ((</>))
-import System.IO.Temp qualified as Temp
-import Unison.Codebase (Codebase)
-import Unison.Codebase qualified as Codebase
-import Unison.Parser.Ann (Ann)
-import Unison.Prelude
-import Unison.Symbol (Symbol)
-import Unison.Test.Ucm (CodebaseFormat, Transcript)
-import Unison.Test.Ucm qualified as Ucm
-import Unison.WatchKind (pattern TestWatch)
-
-transcriptOutputFile :: String -> FilePath
-transcriptOutputFile name =
-  (".." </> "unison-src" </> "transcripts" </> ("GitSync22." ++ name ++ ".output.md"))
-
--- keep it off for CI, since the random temp dirs it generates show up in the
--- output, which causes the test output to change, and the "no change" check
--- to fail
-writeTranscriptOutput :: Bool
-writeTranscriptOutput = False
-
-test :: Test ()
-test =
-  scope "gitsync22" . tests $
-    fastForwardPush
-      : nonFastForwardPush
-      : destroyedRemote
-      : flip
-        map
-        [(Ucm.CodebaseFormat2, "sc")]
-        \(fmt, name) ->
-          scope name $
-            tests
-              [ pushPullTest
-                  "pull-over-deleted-namespace"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```unison:hide
-                      x = 1
-                      ```
-                      ```ucm:hide
-                      .> add
-                      .> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```unison:hide
-                      child.y = 2
-                      ```
-
-                      Should be able to pull a branch from the repo over top of our deleted local branch.
-                      ```ucm
-                      .> add
-                      .> delete.namespace child
-                      .> pull git(${repo}) child
-                      ```
-                    |]
-                  ),
-                pushPullTest
-                  "pull.without-history"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```unison:hide
-                      child.x = 1
-                      ```
-
-                      ```ucm:hide
-                      .> add
-                      ```
-
-                      ```unison:hide
-                      child.y = 2
-                      ```
-
-                      ```ucm:hide
-                      .> add
-                      ```
-
-                      ```unison:hide
-                      child.x = 3
-                      ```
-
-                      ```ucm:hide
-                      .> update
-                      .> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-      Should be able to pull the branch from the remote without its history.
-      Note that this only tests that the pull succeeds, since (at time of writing) we don't
-      track/test transcript output for these tests in the unison repo.
-      ```ucm
-      .> pull.without-history git(${repo}):.child .child
-      .> history .child
-      ```
-    |]
-                  ),
-                pushPullTest
-                  "push-over-deleted-namespace"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```unison:hide
-                      child.x = 1
-                      y = 2
-                      ```
-                      ```ucm:hide
-                      .> add
-                      .> delete.namespace child
-                      .> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```unison:hide
-                      child.z = 3
-                      ```
-
-                      Should be able to push a branch over top of a deleted remote branch.
-                      ```ucm
-                      .> add
-                      .> push.create git(${repo}).child child
-                      ```
-                    |]
-                  ),
-                pushPullTest
-                  "typeAlias"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> alias.type ##Nat builtin.Nat
-                      .> history
-                      .> history builtin
-                      .> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> pull git(${repo})
-                      ```
-                      ```unison
-                      x : Nat
-                      x = 3
-                      ```
-                    |]
-                  ),
-                pushPullTest
-                  "topLevelTerm"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```unison:hide
-                      y = 3
-                      ```
-                      ```ucm
-                      .> add
-                      .> history
-                      .> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> pull git(${repo})
-                      .> find
-                      ```
-                      ```unison
-                      > y
-                      ```
-                    |]
-                  ),
-                pushPullTest
-                  "subNamespace"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> alias.type ##Nat builtin.Nat
-                      ```
-                      ```unison
-                      unique type a.b.C = C Nat
-                      a.b.d = 4
-                      ```
-                      ```ucm
-                      .> add
-                      .> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> pull.silent git(${repo})
-                      .> find
-                      ```
-                      ```unison
-                      > a.b.C.C a.b.d
-                      ```
-                    |]
-                  ),
-                pushPullTest
-                  "accessPatch"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> alias.type ##Nat builtin.Nat
-                      ```
-                      ```unison:hide
-                      unique type A = A Nat
-                      foo = A.A 3
-                      ```
-                      ```ucm
-                      .> debug.file
-                      .> add
-                      ```
-                      ```unison:hide
-                      unique type A = A Nat Nat
-                      foo = A.A 3 3
-                      ```
-                      ```ucm
-                      .> debug.file
-                      .> update
-                      ```
-                      ```ucm
-                      .> view.patch patch
-                      .> push.create git(${repo})
-                      ```
-                   |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> pull.silent git(${repo})
-                      .> view.patch patch
-                      ```
-                   |]
-                  ),
-                pushPullTest
-                  "history"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```unison
-                      foo = 3
-                      ```
-                      ```ucm
-                      .> add
-                      ```
-                      ```unison
-                      foo = 4
-                      ```
-                      ```ucm
-                      .> update
-                      .> history
-                      .> push.create git(${repo})
-                      ```
-                   |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> pull git(${repo})
-                      .> history
-                      .> reset-root #l43v9nr16v
-                      .> history
-                      ```
-                  |] -- Not sure why this hash is here.
-                      -- Is it to test `reset-root`?
-                      -- Or to notice a change in hashing?
-                      -- Or to test that two distinct points of history were pulled?
-                      -- It would be great to not need the explicit hash here,
-                      -- since it does change periodically.
-                      -- Though, I guess that should also be rare, so maybe this is fine.
-                  ),
-                pushPullTest
-                  "one-term"
-                  fmt
-                  -- simplest-author
-                  ( \repo ->
-                      [i|
-                      ```unison
-                      c = 3
-                      ```
-                      ```ucm
-                      .> debug.file
-                      .myLib> add
-                      .myLib> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  -- simplest-user
-                  ( \repo ->
-                      [i|
-                    ```ucm
-                    .yourLib> pull git(${repo})
-                    ```
-                    ```unison
-                    > c
-                    ```
-                    |]
-                  ),
-                pushPullTest
-                  "one-type"
-                  fmt
-                  -- simplest-author
-                  ( \repo ->
-                      [i|
-                    ```unison
-                    structural type Foo = Foo
-                    ```
-                    ```ucm
-                    .myLib> debug.file
-                    .myLib> add
-                    .myLib> push.create git(${repo})
-                    ```
-                    |]
-                  )
-                  -- simplest-user
-                  ( \repo ->
-                      [i|
-                    ```ucm
-                    .yourLib> pull git(${repo})
-                    ```
-                    ```unison
-                    > Foo.Foo
-                    ```
-                    |]
-                  ),
-                pushPullTest
-                  "patching"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .myLib> alias.term ##Nat.+ +
-                      ```
-                      ```unison
-                      improveNat x = x + 3
-                      ```
-                      ```ucm
-                      .myLib> add
-                      .myLib> ls
-                      .myLib> move.namespace .myLib .workaround1552.myLib.v1
-                      .workaround1552.myLib> ls
-                      .workaround1552.myLib> fork v1 v2
-                      .workaround1552.myLib.v2>
-                      ```
-                      ```unison
-                      improveNat x = x + 100
-                      ```
-                      ```ucm
-                      .workaround1552.myLib.v2> update
-                      .workaround1552.myLib> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .myApp> pull git(${repo}).v1 external.yourLib
-                      .myApp> alias.term ##Nat.* *
-                      ````
-                      ```unison
-                      greatApp = improveNat 5 * improveNat 6
-                      > greatApp
-                      ```
-                      ```ucm
-                      .myApp> add
-                      .myApp> pull git(${repo}).v2 external.yourLib
-                      ```
-                      ```unison
-                      > greatApp
-                      ```
-                      ```ucm
-                      .myApp> patch external.yourLib.patch
-                      ```
-                      ```unison
-                      > greatApp
-                      ```
-                    |]
-                  ),
-                -- TODO: remove the alias.type .defns.A A line once patch syncing is fixed
-                pushPullTest
-                  "lightweightPatch"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> builtins.merge
-                      ```
-                      ```unison
-                      structural type A = A Nat
-                      structural type B = B Int
-                      x = 3
-                      y = 4
-                      ```
-                      ```ucm
-                      .defns> add
-                      .patches> replace .defns.A .defns.B
-                      .patches> alias.type .defns.A  A
-                      .patches> replace .defns.x .defns.y
-                      .patches> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> builtins.merge
-                      .> pull git(${repo}) patches
-                      .> view.patch patches.patch
-                      ```
-                    |]
-                  ),
-                watchPushPullTest
-                  "test-watches"
-                  fmt
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> builtins.merge
-                      ```
-                      ```unison
-                      test> pass = [Ok "Passed"]
-                      ```
-                      ```ucm
-                      .> add
-                      .> push.create git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> pull git(${repo})
-                      ```
-                    |]
-                  )
-                  ( \cb -> do
-                      Codebase.runTransaction cb do
-                        void . fmap (fromJust . sequence) $
-                          traverse (Codebase.getWatch cb TestWatch)
-                            =<< Codebase.watches TestWatch
-                  ),
-                gistTest fmt,
-                pushPullBranchesTests fmt,
-                pushPullTest
-                  "fix2068_a_"
-                  fmt
-                  -- this triggers
-                  {-
-                  gitsync22.sc.fix2068(a) EXCEPTION!!!: Called SqliteCodebase.setNamespaceRoot on unknown causal hash CausalHash (fromBase32Hex "codddvgt1ep57qpdkhe2j4pe1ehlpi5iitcrludtb8ves1aaqjl453onvfphqg83vukl7bbrj49itceqfob2b3alf47u4vves5s7pog")
-                  CallStack (from HasCallStack):
-                    error, called at src/Unison/Codebase/SqliteCodebase.hs:1072:17 in unison-parser-typechecker-0.0.0-6U6boimwb8GAC5qrhLfs8h:Unison.Codebase.SqliteCodebase
-                       -}
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> alias.type ##Nat builtin.Nat2
-                      .> alias.type ##Int builtin.Int2
-                      .> push.create git(${repo}).foo.bar
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> pull git(${repo}) pulled
-                      .> view pulled.foo.bar.builtin.Nat2
-                      .> view pulled.foo.bar.builtin.Int2
-                      ```
-                    |]
-                  ),
-                pushPullTest
-                  "fix2068_b_"
-                  fmt
-                  -- this triggers
-                  {-
-                       - gitsync22.sc.fix2068(b) EXCEPTION!!!: I couldn't find the hash ndn6fa85ggqtbgffqhd4d3bca2d08pgp3im36oa8k6p257aid90ovjq75htmh7lmg7akaqneva80ml1o21iscjmp9n1uc3lmqgg9rgg that I just synced to the cached copy of /private/var/folders/6m/p3szds2j67d8vwmxr51yrf5c0000gn/T/git-simple-1047398c149d3d5c/repo.git in "/Users/pchiusano/.cache/unisonlanguage/gitfiles/$x2F$private$x2F$var$x2F$folders$x2F$6m$x2F$p3szds2j67d8vwmxr51yrf5c0000gn$x2F$T$x2F$git-simple-1047398c149d3d5c$x2F$repo$dot$git".
-                  CallStack (from HasCallStack):
-                    error, called at src/Unison/Codebase/SqliteCodebase.hs:1046:13 in unison-parser-typechecker-0.0.0-6U6boimwb8GAC5qrhLfs8h:Unison.Codebase.SqliteCodebase
-                       -}
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> alias.type ##Nat builtin.Nat2
-                      .> alias.type ##Int builtin.Int2
-                      .> push.create git(${repo})
-                      .> push.create git(${repo}).foo.bar
-                      ```
-                    |]
-                  )
-                  ( \repo ->
-                      [i|
-                      ```ucm
-                      .> pull git(${repo}) pulled
-                      .> view pulled.foo.bar.builtin.Nat2
-                      .> view pulled.foo.bar.builtin.Int2
-                      ```
-                    |]
-                  )
-              ]
-
-pushPullTest :: String -> CodebaseFormat -> (FilePath -> Transcript) -> (FilePath -> Transcript) -> Test ()
-pushPullTest name fmt authorScript userScript = scope name do
-  io do
-    repo <- initGitRepo
-    author <- Ucm.initCodebase fmt
-    authorOutput <- Ucm.runTranscript author (authorScript repo)
-    user <- Ucm.initCodebase fmt
-    userOutput <- Ucm.runTranscript user (userScript repo)
-
-    when writeTranscriptOutput $
-      writeUtf8
-        (transcriptOutputFile name)
-        (Text.pack $ authorOutput <> "\n-------\n" <> userOutput)
-
-    -- if we haven't crashed, clean up!
-    removePathForcibly repo
-    Ucm.deleteCodebase author
-    Ucm.deleteCodebase user
-  ok
-
-watchPushPullTest :: String -> CodebaseFormat -> (FilePath -> Transcript) -> (FilePath -> Transcript) -> (Codebase IO Symbol Ann -> IO ()) -> Test ()
-watchPushPullTest name fmt authorScript userScript codebaseCheck = scope name do
-  io do
-    repo <- initGitRepo
-    author <- Ucm.initCodebase fmt
-    authorOutput <- Ucm.runTranscript author (authorScript repo)
-    user <- Ucm.initCodebase fmt
-    userOutput <- Ucm.runTranscript user (userScript repo)
-    Ucm.lowLevel user codebaseCheck
-
-    when writeTranscriptOutput $
-      writeUtf8
-        (transcriptOutputFile name)
-        (Text.pack $ authorOutput <> "\n-------\n" <> userOutput)
-
-    -- if we haven't crashed, clean up!
-    removePathForcibly repo
-    Ucm.deleteCodebase author
-    Ucm.deleteCodebase user
-  ok
-
-gistTest :: CodebaseFormat -> Test ()
-gistTest fmt =
-  pushPullTest "gist" fmt authorScript userScript
-  where
-    authorScript repo =
-      [i|
-        ```unison:hide
-        y = 3
-        ```
-        ```ucm
-        .> add
-        .> gist git(${repo})
-        ```
-      |]
-    userScript repo =
-      [i|
-        ```ucm
-        .> pull git(${repo})#td09c6jlks
-        .> find
-        ```
-        ```unison
-        > y
-        ```
-      |]
-
-pushPullBranchesTests :: CodebaseFormat -> Test ()
-pushPullBranchesTests fmt = scope "branches" $ do
-  simplePushPull
-  multiplePushPull
-  emptyBranchFailure
-  where
-    simplePushPull =
-      let authorScript repo =
-            [i|
-              ```unison:hide
-              y = 3
-              ```
-              ```ucm
-              .> add
-              .> push.create git(${repo}:mybranch).path
-              ```
-            |]
-          userScript repo =
-            [i|
-              ```ucm
-              .> pull git(${repo}:mybranch) .dest
-              .> view .dest.path.y
-              ```
-            |]
-       in pushPullTest "simple" fmt authorScript userScript
-    emptyBranchFailure =
-      let authorScript _repo = ""
-          userScript repo =
-            [i|
-              ```ucm:error
-              .> pull git(${repo}:mybranch) .dest
-              ```
-            |]
-       in pushPullTest "empty" fmt authorScript userScript
-    multiplePushPull =
-      let authorScript repo =
-            [i|
-              ```unison:hide
-              ns1.x = 10
-              ns2.y = 20
-              ```
-              ```ucm
-              .> add
-              .> push.create git(${repo}:mybranch).ns1 .ns1
-              .> push.create git(${repo}:mybranch).ns2 .ns2
-              ```
-              ```unison
-              ns1.x = 11
-              ns1.new = 12
-              ```
-              ```ucm
-              .> update
-              .> push git(${repo}:mybranch).ns1 .ns1
-              ```
-            |]
-          userScript repo =
-            [i|
-              ```ucm
-              .> pull git(${repo}:mybranch).ns1 .ns1
-              .> pull git(${repo}:mybranch).ns2 .ns2
-              .> view .ns1.x
-              .> view .ns1.new
-              .> view .ns2.y
-              ```
-            |]
-       in pushPullTest "multiple" fmt authorScript userScript
-
-fastForwardPush :: Test ()
-fastForwardPush = scope "fastforward-push" do
-  io do
-    repo <- initGitRepo
-    author <- Ucm.initCodebase Ucm.CodebaseFormat2
-    void $
-      Ucm.runTranscript
-        author
-        [i|
-          ```ucm
-          .lib> alias.type ##Nat Nat
-          .lib> push.create git(${repo})
-          .lib> alias.type ##Int Int
-          .lib> push git(${repo})
-          ```
-        |]
-  ok
-
-nonFastForwardPush :: Test ()
-nonFastForwardPush = scope "non-fastforward-push" do
-  io do
-    repo <- initGitRepo
-    author <- Ucm.initCodebase Ucm.CodebaseFormat2
-    void $
-      Ucm.runTranscript
-        author
-        [i|
-          ```ucm:error
-          .lib> alias.type ##Nat Nat
-          .lib> push git(${repo})
-          .lib2> alias.type ##Int Int
-          .lib2> push git(${repo})
-          ```
-        |]
-  ok
-
-destroyedRemote :: Test ()
-destroyedRemote = scope "destroyed-remote" do
-  io do
-    repo <- initGitRepo
-    codebase <- Ucm.initCodebase Ucm.CodebaseFormat2
-    void $
-      Ucm.runTranscript
-        codebase
-        [i|
-          ```ucm
-          .lib> alias.type ##Nat Nat
-          .lib> push.create git(${repo})
-          ```
-        |]
-    reinitRepo repo
-    void $
-      Ucm.runTranscript
-        codebase
-        [i|
-          ```ucm
-          .lib> push.create git(${repo})
-          ```
-        |]
-  ok
-  where
-    reinitRepo repoStr@(Text.pack -> repo) = do
-      removePathForcibly repoStr
-      "git" ["init", "--bare", repo]
-
-initGitRepo :: IO FilePath
-initGitRepo = do
-  tmp <- Temp.getCanonicalTemporaryDirectory >>= flip Temp.createTempDirectory ("git-simple")
-  let repo = tmp </> "repo.git"
-  "git" ["init", "--bare", Text.pack repo]
-  pure repo

unison-cli/tests/Unison/Test/UriParser.hs

@@ -7,15 +7,11 @@ import Data.Void (Void)
 import EasyTest
 import Text.Megaparsec qualified as P
 import Unison.Codebase.Editor.RemoteRepo
-  ( ReadGitRepo (..),
-    ReadRemoteNamespace (..),
+  ( ReadRemoteNamespace (..),
     ShareCodeserver (..),
     ShareUserHandle (..),
-    WriteGitRemoteNamespace (..),
-    WriteGitRepo (..),
     WriteRemoteNamespace (..),
     WriteShareRemoteNamespace (..),
-    pattern ReadGitRemoteNamespace,
     pattern ReadShareLooseCode,
   )
 import Unison.Codebase.Editor.UriParser qualified as UriParser
@@ -34,22 +30,7 @@ test =
         [ ("unisonweb.base._releases.M4", looseR "unisonweb" ["base", "_releases", "M4"]),
           ("project", branchR (This "project")),
           ("/branch", branchR (That "branch")),
-          ("project/branch", branchR (These "project" "branch")),
-          ("git(/srv/git/project.git)", gitR "/srv/git/project.git" Nothing Nothing []),
-          ("git(/srv/git/project.git:abc)#def.hij.klm", gitR "/srv/git/project.git" (Just "abc") (sch "def") ["hij", "klm"]),
-          ("git(srv/git/project.git)", gitR "srv/git/project.git" Nothing Nothing []),
-          ("git(srv/git/project.git:abc)#def.hij.klm", gitR "srv/git/project.git" (Just "abc") (sch "def") ["hij", "klm"]),
-          ("git(file:///srv/git/project.git)", gitR "file:///srv/git/project.git" Nothing Nothing []),
-          ("git(file:///srv/git/project.git:abc)#def.hij.klm", gitR "file:///srv/git/project.git" (Just "abc") (sch "def") ["hij", "klm"]),
-          ("git(file://srv/git/project.git)", gitR "file://srv/git/project.git" Nothing Nothing []),
-          ("git(file://srv/git/project.git:abc)#def.hij.klm", gitR "file://srv/git/project.git" (Just "abc") (sch "def") ["hij", "klm"]),
-          ("git(https://example.com/git/project.git)", gitR "https://example.com/git/project.git" Nothing Nothing []),
-          ("git(https://user@example.com/git/project.git:abc)#def.hij.klm", gitR "https://user@example.com/git/project.git" (Just "abc") (sch "def") ["hij", "klm"]),
-          ("git(ssh://git@8.8.8.8:222/user/project.git)", gitR "ssh://git@8.8.8.8:222/user/project.git" Nothing Nothing []),
-          ("git(ssh://git@github.com/user/project.git:abc)#def.hij.klm", gitR "ssh://git@github.com/user/project.git" (Just "abc") (sch "def") ["hij", "klm"]),
-          ("git(git@github.com:user/project.git)", gitR "git@github.com:user/project.git" Nothing Nothing []),
-          ("git(github.com:user/project.git)", gitR "github.com:user/project.git" Nothing Nothing []),
-          ("git(git@github.com:user/project.git:abc)#def.hij.klm", gitR "git@github.com:user/project.git" (Just "abc") (sch "def") ["hij", "klm"])
+          ("project/branch", branchR (These "project" "branch"))
         ]
         [".unisonweb.base"],
       parserTests
@@ -58,36 +39,15 @@ test =
         [ ("unisonweb.base._releases.M4", looseW "unisonweb" ["base", "_releases", "M4"]),
           ("project", branchW (This "project")),
           ("/branch", branchW (That "branch")),
-          ("project/branch", branchW (These "project" "branch")),
-          ("git(/srv/git/project.git)", gitW "/srv/git/project.git" Nothing []),
-          ("git(srv/git/project.git)", gitW "srv/git/project.git" Nothing []),
-          ("git(file:///srv/git/project.git)", gitW "file:///srv/git/project.git" Nothing []),
-          ("git(file://srv/git/project.git)", gitW "file://srv/git/project.git" Nothing []),
-          ("git(https://example.com/git/project.git)", gitW "https://example.com/git/project.git" Nothing []),
-          ("git(ssh://git@8.8.8.8:222/user/project.git)", gitW "ssh://git@8.8.8.8:222/user/project.git" Nothing []),
-          ("git(git@github.com:user/project.git)", gitW "git@github.com:user/project.git" Nothing []),
-          ("git(github.com:user/project.git)", gitW "github.com:user/project.git" Nothing [])
+          ("project/branch", branchW (These "project" "branch"))
         ]
-        [ ".unisonweb.base",
-          "git(/srv/git/project.git:abc)#def.hij.klm",
-          "git(srv/git/project.git:abc)#def.hij.klm",
-          "git(file:///srv/git/project.git:abc)#def.hij.klm",
-          "git(file://srv/git/project.git:abc)#def.hij.klm",
-          "git(https://user@example.com/git/project.git:abc)#def.hij.klm",
-          "git(ssh://git@github.com/user/project.git:abc)#def.hij.klm",
-          "git(git@github.com:user/project.git:abc)#def.hij.klm"
+        [ ".unisonweb.base"
         ]
     ]
 
 mkPath :: [Text] -> Path.Path
 mkPath = Path.fromList . fmap NameSegment
 
-gitR :: Text -> Maybe Text -> Maybe ShortCausalHash -> [Text] -> ReadRemoteNamespace void
-gitR url ref sch path = ReadRemoteNamespaceGit (ReadGitRemoteNamespace (ReadGitRepo url ref) sch (mkPath path))
-
-gitW :: Text -> Maybe Text -> [Text] -> WriteRemoteNamespace void
-gitW url branch path = WriteRemoteNamespaceGit (WriteGitRemoteNamespace (WriteGitRepo url branch) (mkPath path))
-
 looseR :: Text -> [Text] -> ReadRemoteNamespace void
 looseR user path =
   ReadShare'LooseCode (ReadShareLooseCode DefaultCodeserver (ShareUserHandle user) (mkPath path))

unison-cli/unison-cli.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
@@ -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
@@ -54,6 +55,7 @@ library
       Unison.Codebase.Editor.HandleInput.Branch
       Unison.Codebase.Editor.HandleInput.Branches
       Unison.Codebase.Editor.HandleInput.BranchRename
+      Unison.Codebase.Editor.HandleInput.CommitUpgrade
       Unison.Codebase.Editor.HandleInput.DebugDefinition
       Unison.Codebase.Editor.HandleInput.DebugFoldRanges
       Unison.Codebase.Editor.HandleInput.DeleteBranch
@@ -96,6 +98,7 @@ library
       Unison.Codebase.Editor.Slurp
       Unison.Codebase.Editor.SlurpComponent
       Unison.Codebase.Editor.SlurpResult
+      Unison.Codebase.Editor.StructuredArgument
       Unison.Codebase.Editor.TodoOutput
       Unison.Codebase.Editor.UCMVersion
       Unison.Codebase.Editor.UriParser
@@ -426,7 +429,6 @@ test-suite cli-tests
   other-modules:
       Unison.Test.ClearCache
       Unison.Test.Cli.Monad
-      Unison.Test.GitSync
       Unison.Test.LSP
       Unison.Test.Ucm
       Unison.Test.UriParser

unison-core/src/Unison/DataDeclaration.hs

@@ -33,10 +33,11 @@ module Unison.DataDeclaration
     constructors_,
     asDataDecl_,
     declAsDataDecl_,
+    setConstructorNames,
   )
 where
 
-import Control.Lens (Iso', Lens', imap, iso, lens, over, _3)
+import Control.Lens (Iso', Lens', imap, iso, lens, over, set, _2, _3)
 import Control.Monad.State (evalState)
 import Data.Map qualified as Map
 import Data.Set qualified as Set
@@ -164,6 +165,20 @@ constructorVars dd = fst <$> constructors dd
 constructorNames :: (Var v) => DataDeclaration v a -> [Text]
 constructorNames dd = Var.name <$> constructorVars dd
 
+-- | Overwrite the constructor names with the given list, given in canonical order, which is assumed to be of the
+-- correct length.
+--
+-- Presumably this is called because the decl was loaded from the database outside of the context of a namespace,
+-- since it's not stored with names there, so we had plugged in dummy names like "Constructor1", "Constructor2", ...
+--
+-- Then, at some point, we discover the constructors' names in a namespace, and now we'd like to combine the two
+-- together to get a Decl structure in memory with good/correct names for constructors.
+setConstructorNames :: [v] -> Decl v a -> Decl v a
+setConstructorNames constructorNames =
+  over
+    (declAsDataDecl_ . constructors_)
+    (zipWith (set _2) constructorNames)
+
 -- This function is unsound, since the `rid` and the `decl` have to match.
 -- It should probably be hashed directly from the Decl, once we have a
 -- reliable way of doing that. —AI

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/DeclCoherencyCheck.hs

@@ -82,10 +82,11 @@
 module Unison.Merge.DeclCoherencyCheck
   ( IncoherentDeclReason (..),
     checkDeclCoherency,
+    lenientCheckDeclCoherency,
   )
 where
 
-import Control.Lens (view, (%=), (.=))
+import Control.Lens (over, view, (%=), (.=), _2)
 import Control.Monad.Except (ExceptT)
 import Control.Monad.Except qualified as Except
 import Control.Monad.State.Strict (StateT)
@@ -101,6 +102,7 @@ import Data.Maybe (fromJust)
 import Data.Set qualified as Set
 import U.Codebase.Reference (Reference' (..), TypeReference, TypeReferenceId)
 import Unison.ConstructorReference (GConstructorReference (..))
+import Unison.DataDeclaration.ConstructorId (ConstructorId)
 import Unison.Merge.DeclNameLookup (DeclNameLookup (..))
 import Unison.Name (Name)
 import Unison.Name qualified as Name
@@ -108,9 +110,8 @@ import Unison.NameSegment (NameSegment)
 import Unison.Prelude
 import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent
-import Unison.Sqlite (Transaction)
 import Unison.Util.Defns (Defns (..), DefnsF)
-import Unison.Util.Map qualified as Map (deleteLookup, upsertF)
+import Unison.Util.Map qualified as Map (deleteLookup, deleteLookupJust, upsertF)
 import Unison.Util.Nametree (Nametree (..))
 
 data IncoherentDeclReason
@@ -119,7 +120,7 @@ data IncoherentDeclReason
     --   Foo#Foo
     --   Foo.Bar#Foo#0
     --   Foo.Some.Other.Name.For.Bar#Foo#0
-    IncoherentDeclReason'ConstructorAlias !Name !Name
+    IncoherentDeclReason'ConstructorAlias !Name !Name !Name -- type, first constructor, second constructor
   | IncoherentDeclReason'MissingConstructorName !Name
   | -- | A second naming of a decl was discovered underneath its name, e.g.
     --
@@ -129,9 +130,11 @@ data IncoherentDeclReason
   | IncoherentDeclReason'StrayConstructor !Name
 
 checkDeclCoherency ::
-  (TypeReferenceId -> Transaction Int) ->
+  forall m.
+  Monad m =>
+  (TypeReferenceId -> m Int) ->
   Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
-  Transaction (Either IncoherentDeclReason DeclNameLookup)
+  m (Either IncoherentDeclReason DeclNameLookup)
 checkDeclCoherency loadDeclNumConstructors =
   Except.runExceptT
     . fmap (view #declNameLookup)
@@ -140,10 +143,10 @@ checkDeclCoherency loadDeclNumConstructors =
   where
     go ::
       [NameSegment] ->
-      (Nametree (Defns (Map NameSegment Referent) (Map NameSegment TypeReference))) ->
-      StateT DeclCoherencyCheckState (ExceptT IncoherentDeclReason Transaction) ()
-    go prefix (Nametree Defns {terms, types} children) = do
-      for_ (Map.toList terms) \case
+      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
+      StateT DeclCoherencyCheckState (ExceptT IncoherentDeclReason m) ()
+    go prefix (Nametree defns children) = do
+      for_ (Map.toList defns.terms) \case
         (_, Referent.Ref _) -> pure ()
         (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure ()
         (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do
@@ -152,35 +155,33 @@ checkDeclCoherency loadDeclNumConstructors =
           #expectedConstructors .= expectedConstructors1
           where
             f ::
-              Maybe (Name, IntMap MaybeConstructorName) ->
-              Either IncoherentDeclReason (Name, IntMap MaybeConstructorName)
+              Maybe (Name, ConstructorNames) ->
+              Either IncoherentDeclReason (Name, ConstructorNames)
             f = \case
-              Nothing -> Left (IncoherentDeclReason'StrayConstructor (fullName name))
-              Just (typeName, expected) -> (typeName,) <$> IntMap.alterF g (fromIntegral @Word64 @Int conId) expected
-                where
-                  g :: Maybe MaybeConstructorName -> Either IncoherentDeclReason (Maybe MaybeConstructorName)
-                  g = \case
-                    Nothing -> error "didnt put expected constructor id"
-                    Just NoConstructorNameYet -> Right (Just (YesConstructorName (fullName name)))
-                    Just (YesConstructorName firstName) ->
-                      Left (IncoherentDeclReason'ConstructorAlias firstName (fullName name))
+              Nothing -> Left (IncoherentDeclReason'StrayConstructor name1)
+              Just (typeName, expected) ->
+                case recordConstructorName conId name1 expected of
+                  Left existingName -> Left (IncoherentDeclReason'ConstructorAlias typeName existingName name1)
+                  Right expected1 -> Right (typeName, expected1)
+              where
+                name1 = fullName name
 
       childrenWeWentInto <-
-        forMaybe (Map.toList types) \case
+        forMaybe (Map.toList defns.types) \case
           (_, ReferenceBuiltin _) -> pure Nothing
           (name, ReferenceDerived typeRef) -> do
             DeclCoherencyCheckState {expectedConstructors} <- State.get
             whatHappened <- do
               let recordNewDecl ::
-                    Maybe (Name, IntMap MaybeConstructorName) ->
-                    Compose (ExceptT IncoherentDeclReason Transaction) WhatHappened (Name, IntMap MaybeConstructorName)
+                    Maybe (Name, ConstructorNames) ->
+                    Compose (ExceptT IncoherentDeclReason m) WhatHappened (Name, ConstructorNames)
                   recordNewDecl =
                     Compose . \case
                       Just (shorterTypeName, _) -> Except.throwError (IncoherentDeclReason'NestedDeclAlias shorterTypeName typeName)
                       Nothing ->
                         lift (loadDeclNumConstructors typeRef) <&> \case
                           0 -> UninhabitedDecl
-                          n -> InhabitedDecl (typeName, IntMap.fromAscList [(i, NoConstructorNameYet) | i <- [0 .. n - 1]])
+                          n -> InhabitedDecl (typeName, emptyConstructorNames n)
               lift (getCompose (Map.upsertF recordNewDecl typeRef expectedConstructors))
             case whatHappened of
               UninhabitedDecl -> do
@@ -197,18 +198,88 @@ checkDeclCoherency loadDeclNumConstructors =
                 let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) =
                       Map.deleteLookup typeRef expectedConstructors
                 constructorNames <-
-                  unMaybeConstructorNames maybeConstructorNames & onNothing do
+                  sequence (IntMap.elems maybeConstructorNames) & onNothing do
                     Except.throwError (IncoherentDeclReason'MissingConstructorName typeName)
                 #expectedConstructors .= expectedConstructors1
-                #declNameLookup %= \declNameLookup ->
-                  DeclNameLookup
-                    { constructorToDecl =
-                        List.foldl'
-                          (\acc constructorName -> Map.insert constructorName typeName acc)
-                          declNameLookup.constructorToDecl
-                          constructorNames,
-                      declToConstructors = Map.insert typeName constructorNames declNameLookup.declToConstructors
-                    }
+                #declNameLookup . #constructorToDecl %= \constructorToDecl ->
+                  List.foldl'
+                    (\acc constructorName -> Map.insert constructorName typeName acc)
+                    constructorToDecl
+                    constructorNames
+                #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames
+                pure (Just name)
+            where
+              typeName = fullName name
+
+      let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto
+      for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child
+      where
+        fullName name =
+          Name.fromReverseSegments (name :| prefix)
+
+-- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns a mapping from decl name to
+-- constructor names, where constructor names can be missing.
+--
+-- This function exists merely to extract a best-effort decl-name-to-constructor-name mapping for the LCA of a merge.
+-- We require Alice and Bob to have coherent decls, but their LCA is out of the user's control and may have incoherent
+-- decls, and whether or not it does, we still need to compute *some* syntactic hash for its decls.
+lenientCheckDeclCoherency ::
+  forall m.
+  Monad m =>
+  (TypeReferenceId -> m Int) ->
+  Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
+  m (Map Name [Maybe Name])
+lenientCheckDeclCoherency loadDeclNumConstructors =
+  fmap (view #declToConstructors)
+    . (`State.execStateT` LenientDeclCoherencyCheckState Map.empty Map.empty)
+    . go []
+  where
+    go ::
+      [NameSegment] ->
+      (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
+      StateT LenientDeclCoherencyCheckState m ()
+    go prefix (Nametree defns children) = do
+      for_ (Map.toList defns.terms) \case
+        (_, Referent.Ref _) -> pure ()
+        (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure ()
+        (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do
+          #expectedConstructors %= Map.adjust (Map.map (lenientRecordConstructorName conId (fullName name))) typeRef
+
+      childrenWeWentInto <-
+        forMaybe (Map.toList defns.types) \case
+          (_, ReferenceBuiltin _) -> pure Nothing
+          (name, ReferenceDerived typeRef) -> do
+            whatHappened <- do
+              let recordNewDecl :: m (WhatHappened (Map Name ConstructorNames))
+                  recordNewDecl =
+                    loadDeclNumConstructors typeRef <&> \case
+                      0 -> UninhabitedDecl
+                      n -> InhabitedDecl (Map.singleton typeName (emptyConstructorNames n))
+              state <- State.get
+              lift (getCompose (Map.upsertF (\_ -> Compose recordNewDecl) typeRef state.expectedConstructors))
+            case whatHappened of
+              UninhabitedDecl -> do
+                #declToConstructors %= Map.insert typeName []
+                pure Nothing
+              InhabitedDecl expectedConstructors1 -> do
+                let child = Map.findWithDefault (Nametree (Defns Map.empty Map.empty) Map.empty) name children
+                #expectedConstructors .= expectedConstructors1
+                go (name : prefix) child
+                state <- State.get
+                let (maybeConstructorNames, expectedConstructors) =
+                      Map.alterF f typeRef state.expectedConstructors
+                      where
+                        f ::
+                          Maybe (Map Name ConstructorNames) ->
+                          (ConstructorNames, Maybe (Map Name ConstructorNames))
+                        f =
+                          -- fromJust is safe here because we upserted `typeRef` key above
+                          -- deleteLookupJust is safe here because we upserted `typeName` key above
+                          fromJust
+                            >>> Map.deleteLookupJust typeName
+                            >>> over _2 \m -> if Map.null m then Nothing else Just m
+                #expectedConstructors .= expectedConstructors
+                #declToConstructors %= Map.insert typeName (IntMap.elems maybeConstructorNames)
                 pure (Just name)
             where
               typeName = fullName name
@@ -220,23 +291,47 @@ checkDeclCoherency loadDeclNumConstructors =
           Name.fromReverseSegments (name :| prefix)
 
 data DeclCoherencyCheckState = DeclCoherencyCheckState
-  { expectedConstructors :: !(Map TypeReferenceId (Name, IntMap MaybeConstructorName)),
+  { expectedConstructors :: !(Map TypeReferenceId (Name, ConstructorNames)),
     declNameLookup :: !DeclNameLookup
   }
   deriving stock (Generic)
 
-data MaybeConstructorName
-  = NoConstructorNameYet
-  | YesConstructorName !Name
+data LenientDeclCoherencyCheckState = LenientDeclCoherencyCheckState
+  { expectedConstructors :: !(Map TypeReferenceId (Map Name ConstructorNames)),
+    declToConstructors :: !(Map Name [Maybe Name])
+  }
+  deriving stock (Generic)
 
-unMaybeConstructorNames :: IntMap MaybeConstructorName -> Maybe [Name]
-unMaybeConstructorNames =
-  traverse f . IntMap.elems
+-- A partial mapping from constructor id to name; a collection of constructor names starts out with the correct number
+-- of keys (per the number of data constructors) all mapped to Nothing. Then, as names are discovered by walking a
+-- name tree, Nothings become Justs.
+type ConstructorNames =
+  IntMap (Maybe Name)
+
+-- Make an empty set of constructor names given the number of constructors.
+emptyConstructorNames :: Int -> ConstructorNames
+emptyConstructorNames numConstructors =
+  IntMap.fromAscList [(i, Nothing) | i <- [0 .. numConstructors - 1]]
+
+recordConstructorName :: HasCallStack => ConstructorId -> Name -> ConstructorNames -> Either Name ConstructorNames
+recordConstructorName conId conName =
+  IntMap.alterF f (fromIntegral @Word64 @Int conId)
   where
-    f :: MaybeConstructorName -> Maybe Name
+    f :: Maybe (Maybe Name) -> Either Name (Maybe (Maybe Name))
     f = \case
-      NoConstructorNameYet -> Nothing
-      YesConstructorName name -> Just name
+      Nothing -> error (reportBug "E397219" ("recordConstructorName: didn't expect constructor id " ++ show conId))
+      Just Nothing -> Right (Just (Just conName))
+      Just (Just existingName) -> Left existingName
+
+lenientRecordConstructorName :: ConstructorId -> Name -> ConstructorNames -> ConstructorNames
+lenientRecordConstructorName conId conName =
+  IntMap.adjust f (fromIntegral @Word64 @Int conId)
+  where
+    f :: Maybe Name -> Maybe Name
+    f = \case
+      Nothing -> Just conName
+      -- Ignore constructor alias, just keep first name we found
+      Just existingName -> Just existingName
 
 data WhatHappened a
   = UninhabitedDecl

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

@@ -2,19 +2,13 @@ module Unison.Merge.DeclNameLookup
   ( DeclNameLookup (..),
     expectDeclName,
     expectConstructorNames,
-    setConstructorNames,
   )
 where
 
-import Control.Lens (over)
 import Data.Map.Strict qualified as Map
 import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
-import Unison.DataDeclaration (Decl)
-import Unison.DataDeclaration qualified as DataDeclaration
 import Unison.Name (Name)
 import Unison.Prelude
-import Unison.Syntax.Name qualified as Name
-import Unison.Var (Var)
 
 -- | A lookup from decl-to-constructor name and vice-versa.
 --
@@ -57,22 +51,3 @@ expectConstructorNames DeclNameLookup {declToConstructors} x =
   case Map.lookup x declToConstructors of
     Nothing -> error (reportBug "E077058" ("Expected decl name key " <> show x <> " in decl name lookup"))
     Just y -> y
-
--- | Set the constructor names of a data declaration.
---
--- Presumably this is used because the decl was loaded from the database outside of the context of a namespace, because
--- it's not stored with names there, so we plugged in dummy names like "Constructor1", "Constructor2", ...
---
--- Then, at some point, a `DeclNameLookup` was constructed for the corresponding namespace, and now we'd like to
--- combine the two together to get a Decl structure in memory with good/correct names for constructors.
-setConstructorNames :: forall a v. Var v => DeclNameLookup -> Name -> Decl v a -> Decl v a
-setConstructorNames declNameLookup name =
-  case Map.lookup name declNameLookup.declToConstructors of
-    Nothing -> id
-    Just constructorNames ->
-      over
-        (DataDeclaration.declAsDataDecl_ . DataDeclaration.constructors_)
-        ( zipWith
-            (\realConName (ann, _junkConName, typ) -> (ann, Name.toVar realConName, typ))
-            constructorNames
-        )

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

@@ -9,23 +9,30 @@ import Data.Semialign (alignWith)
 import Data.Set qualified as Set
 import Data.These (These (..))
 import U.Codebase.Reference (TypeReference)
-import Unison.Hash (Hash)
+import Unison.DataDeclaration (Decl)
+import Unison.DataDeclaration qualified as DataDeclaration
+import Unison.Hash (Hash (Hash))
 import Unison.HashQualified' qualified as HQ'
 import Unison.Merge.Database (MergeDatabase (..))
 import Unison.Merge.DeclNameLookup (DeclNameLookup)
 import Unison.Merge.DeclNameLookup qualified as DeclNameLookup
 import Unison.Merge.DiffOp (DiffOp (..))
-import Unison.Merge.Synhash qualified as Synhash
+import Unison.Merge.Synhash
 import Unison.Merge.Synhashed (Synhashed (..))
 import Unison.Merge.ThreeWay (ThreeWay (..))
+import Unison.Merge.ThreeWay qualified as ThreeWay
 import Unison.Merge.TwoWay (TwoWay (..))
 import Unison.Merge.Updated (Updated (..))
 import Unison.Name (Name)
+import Unison.Parser.Ann (Ann)
 import Unison.Prelude hiding (catMaybes)
 import Unison.PrettyPrintEnv (PrettyPrintEnv (..))
 import Unison.PrettyPrintEnv qualified as Ppe
+import Unison.Reference (Reference' (..), TypeReferenceId)
 import Unison.Referent (Referent)
 import Unison.Sqlite (Transaction)
+import Unison.Symbol (Symbol)
+import Unison.Syntax.Name qualified as Name
 import Unison.Util.BiMultimap (BiMultimap)
 import Unison.Util.BiMultimap qualified as BiMultimap
 import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith)
@@ -40,12 +47,29 @@ import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith)
 -- branches. If the hash of a name did not change, it will not appear in the map.
 nameBasedNamespaceDiff ::
   MergeDatabase ->
-  ThreeWay DeclNameLookup ->
+  TwoWay DeclNameLookup ->
+  Map Name [Maybe Name] ->
   ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
   Transaction (TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference))
-nameBasedNamespaceDiff db declNameLookups defns = do
-  diffs <- sequence (synhashDefns <$> declNameLookups <*> defns)
-  pure (diffNamespaceDefns diffs.lca <$> TwoWay {alice = diffs.alice, bob = diffs.bob})
+nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors defns = do
+  lcaHashes <-
+    synhashDefnsWith
+      hashTerm
+      ( \name -> \case
+          ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin)
+          ReferenceDerived ref ->
+            case sequence (lcaDeclToConstructors Map.! name) of
+              -- If we don't have a name for every constructor, that's okay, just use a dummy syntactic hash here.
+              -- This is safe; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk
+              -- that we accidentally get an equal hash and classify a real update as unchanged.
+              Nothing -> pure (Hash mempty)
+              Just names -> do
+                decl <- loadDeclWithGoodConstructorNames names ref
+                pure (synhashDerivedDecl ppe name decl)
+      )
+      defns.lca
+  hashes <- sequence (synhashDefns <$> declNameLookups <*> ThreeWay.forgetLca defns)
+  pure (diffNamespaceDefns lcaHashes <$> hashes)
   where
     synhashDefns ::
       DeclNameLookup ->
@@ -55,16 +79,20 @@ nameBasedNamespaceDiff db declNameLookups defns = do
       -- FIXME: use cache so we only synhash each thing once
       synhashDefnsWith hashTerm hashType
       where
-        hashTerm :: Referent -> Transaction Hash
-        hashTerm =
-          Synhash.hashTerm db.loadV1Term ppe
-
         hashType :: Name -> TypeReference -> Transaction Hash
-        hashType name =
-          Synhash.hashDecl
-            (fmap (DeclNameLookup.setConstructorNames declNameLookup name) . db.loadV1Decl)
-            ppe
-            name
+        hashType name = \case
+          ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin)
+          ReferenceDerived ref -> do
+            decl <- loadDeclWithGoodConstructorNames (DeclNameLookup.expectConstructorNames declNameLookup name) ref
+            pure (synhashDerivedDecl ppe name decl)
+
+    loadDeclWithGoodConstructorNames :: [Name] -> TypeReferenceId -> Transaction (Decl Symbol Ann)
+    loadDeclWithGoodConstructorNames names =
+      fmap (DataDeclaration.setConstructorNames (map Name.toVar names)) . db.loadV1Decl
+
+    hashTerm :: Referent -> Transaction Hash
+    hashTerm =
+      synhashTerm db.loadV1Term ppe
 
     ppe :: PrettyPrintEnv
     ppe =

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/Synhash.hs

@@ -24,9 +24,10 @@
 -- "foo" would have the same syntactic hash. This indicates (to our merge algorithm) that this was an auto-propagated
 -- update.
 module Unison.Merge.Synhash
-  ( hashType,
-    hashTerm,
-    hashDecl,
+  ( synhashType,
+    synhashTerm,
+    synhashBuiltinDecl,
+    synhashDerivedDecl,
   )
 where
 
@@ -72,8 +73,8 @@ isDeclTag, isTermTag :: H.Token Hash
 isDeclTag = H.Tag 0
 isTermTag = H.Tag 1
 
-hashBuiltinDecl :: Text -> Hash
-hashBuiltinDecl name =
+synhashBuiltinDecl :: Text -> Hash
+synhashBuiltinDecl name =
   H.accumulate [isBuiltinTag, isDeclTag, H.Text name]
 
 hashBuiltinTerm :: Text -> Hash
@@ -104,23 +105,6 @@ hashConstructorNameToken declName conName =
             )
    in H.Text (Name.toText strippedConName)
 
--- | Syntactically hash a decl, using reference names rather than hashes. Two decls will have the same syntactic hash if
--- they they are the same sort of decl (both are data decls or both are effect decls), the unique type guid is the same,
--- the constructors appear in the same order and have the same names, and the constructors' types have the same
--- syntactic hashes.
-hashDecl ::
-  (Monad m, Var v) =>
-  (TypeReferenceId -> m (Decl v a)) ->
-  PrettyPrintEnv ->
-  Name ->
-  TypeReference ->
-  m Hash
-hashDecl loadDecl ppe name = \case
-  ReferenceBuiltin builtin -> pure (hashBuiltinDecl builtin)
-  ReferenceDerived ref -> do
-    decl <- loadDecl ref
-    pure (hashDerivedDecl ppe name decl)
-
 hashDerivedTerm :: Var v => PrettyPrintEnv -> Term v a -> Hash
 hashDerivedTerm ppe t =
   H.accumulate $ isNotBuiltinTag : hashTermTokens ppe t
@@ -148,8 +132,12 @@ hashDeclTokens :: Var v => PrettyPrintEnv -> Name -> Decl v a -> [Token]
 hashDeclTokens ppe name decl =
   hashConstructorType (DD.constructorType decl) : hashDataDeclTokens ppe name (DD.asDataDecl decl)
 
-hashDerivedDecl :: Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash
-hashDerivedDecl ppe name decl =
+-- | Syntactically hash a decl, using reference names rather than hashes. Two decls will have the same syntactic hash if
+-- they they are the same sort of decl (both are data decls or both are effect decls), the unique type guid is the same,
+-- the constructors appear in the same order and have the same names, and the constructors' types have the same
+-- syntactic hashes.
+synhashDerivedDecl :: Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash
+synhashDerivedDecl ppe name decl =
   H.accumulate $ isNotBuiltinTag : hashDeclTokens ppe name decl
 
 hashHQNameToken :: HashQualified Name -> Token
@@ -218,8 +206,14 @@ hashReferentTokens ppe referent =
 -- | Syntactically hash a term, using reference names rather than hashes.
 -- Two terms will have the same syntactic hash if they would
 -- print the the same way under the given pretty-print env.
-hashTerm :: forall m v a. (Monad m, Var v) => (TypeReferenceId -> m (Term v a)) -> PrettyPrintEnv -> V1.Referent -> m Hash
-hashTerm loadTerm ppe = \case
+synhashTerm ::
+  forall m v a.
+  (Monad m, Var v) =>
+  (TypeReferenceId -> m (Term v a)) ->
+  PrettyPrintEnv ->
+  V1.Referent ->
+  m Hash
+synhashTerm loadTerm ppe = \case
   V1.Referent.Con ref CT.Data -> pure (hashDerivedTerm ppe (Term.constructor @v () ref))
   V1.Referent.Con ref CT.Effect -> pure (hashDerivedTerm ppe (Term.request @v () ref))
   V1.Referent.Ref (ReferenceBuiltin builtin) -> pure (hashBuiltinTerm builtin)
@@ -269,8 +263,8 @@ hashTermFTokens ppe = \case
 -- | Syntactically hash a type, using reference names rather than hashes.
 -- Two types will have the same syntactic hash if they would
 -- print the the same way under the given pretty-print env.
-hashType :: Var v => PrettyPrintEnv -> Type v a -> Hash
-hashType ppe t =
+synhashType :: Var v => PrettyPrintEnv -> Type v a -> Hash
+synhashType ppe t =
   H.accumulate $ hashTypeTokens ppe t
 
 hashTypeTokens :: forall v a. Var v => PrettyPrintEnv -> Type v a -> [Token]

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-share-api/package.yaml

@@ -17,6 +17,7 @@ dependencies:
   - bytes
   - bytestring
   - containers
+  - Diff
   - directory
   - errors
   - extra

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

@@ -14,6 +14,7 @@ module Unison.Server.Backend
     FoundRef (..),
     IncludeCycles (..),
     DefinitionResults (..),
+    SyntaxText,
 
     -- * Endpoints
     fuzzyFind,
@@ -66,7 +67,9 @@ module Unison.Server.Backend
 
     -- * Re-exported for Share Server
     termsToSyntax,
+    termsToSyntaxOf,
     typesToSyntax,
+    typesToSyntaxOf,
     definitionResultsDependencies,
     evalDocRef,
     mkTermDefinition,
@@ -88,7 +91,6 @@ import Data.Set qualified as Set
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as TextE
 import Data.Text.Lazy (toStrict)
-import Data.Tuple.Extra (dupe)
 import Data.Yaml qualified as Yaml
 import Lucid qualified
 import System.Directory
@@ -148,7 +150,7 @@ import Unison.PrettyPrintEnvDecl qualified as PPED
 import Unison.PrettyPrintEnvDecl.Names qualified as PPED
 import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
 import Unison.Project.Util qualified as ProjectUtils
-import Unison.Reference (Reference, TermReference)
+import Unison.Reference (Reference, TermReference, TypeReference)
 import Unison.Reference qualified as Reference
 import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent
@@ -845,14 +847,13 @@ docsForDefinitionName ::
   NameSearch Sqlite.Transaction ->
   Names.SearchType ->
   Name ->
-  IO [TermReference]
+  Sqlite.Transaction [TermReference]
 docsForDefinitionName codebase (NameSearch {termSearch}) searchType name = do
   let potentialDocNames = [name, name Cons.:> NameSegment.docSegment]
-  Codebase.runTransaction codebase do
-    refs <-
-      potentialDocNames & foldMapM \name ->
-        lookupRelativeHQRefs' termSearch searchType (HQ'.NameOnly name)
-    filterForDocs (toList refs)
+  refs <-
+    potentialDocNames & foldMapM \name ->
+      lookupRelativeHQRefs' termSearch searchType (HQ'.NameOnly name)
+  filterForDocs (toList refs)
   where
     filterForDocs :: [Referent] -> Sqlite.Transaction [TermReference]
     filterForDocs rs = do
@@ -1119,19 +1120,55 @@ displayType codebase = \case
     decl <- Codebase.unsafeGetTypeDeclaration codebase rid
     pure (UserObject decl)
 
+-- | Version of 'termsToSyntax' which works over arbitrary traversals.
+--
+-- E.g.
+-- @@
+-- termsToSyntaxOf suff width pped traversed [(ref, dispObj)]
+--
+-- or
+--
+-- termsToSyntaxOf suff width pped id (ref, dispObj)
+--
+-- or
+--
+-- termsToSyntaxOf suff width pped Map.asList_ (Map.singleton ref dispObj)
+-- @@
+-- e.g. 'traversed'
+termsToSyntaxOf ::
+  (Var v) =>
+  (Ord a) =>
+  Suffixify ->
+  Width ->
+  PPED.PrettyPrintEnvDecl ->
+  Traversal s t (TermReference, DisplayObject (Type v a) (Term v a)) (TermReference, DisplayObject SyntaxText SyntaxText) ->
+  s ->
+  t
+termsToSyntaxOf suff width ppe0 trav s =
+  s & over (unsafePartsOf trav) (\displayObjs -> termsToSyntax suff width ppe0 displayObjs)
+
+-- | Converts Type Display Objects into Syntax Text.
 termsToSyntax ::
   (Var v) =>
   (Ord a) =>
   Suffixify ->
   Width ->
   PPED.PrettyPrintEnvDecl ->
-  Map Reference.Reference (DisplayObject (Type v a) (Term v a)) ->
-  Map Reference.Reference (DisplayObject SyntaxText SyntaxText)
+  [(TermReference, (DisplayObject (Type v a) (Term v a)))] ->
+  [(TermReference, DisplayObject SyntaxText SyntaxText)]
 termsToSyntax suff width ppe0 terms =
-  Map.fromList . map go . Map.toList $
-    Map.mapKeys
-      (first (PPE.termName ppeDecl . Referent.Ref) . dupe)
-      terms
+  terms
+    <&> \(r, dispObj) ->
+      let n = PPE.termName ppeDecl . Referent.Ref $ r
+       in (r,) case dispObj of
+            DisplayObject.BuiltinObject typ ->
+              DisplayObject.BuiltinObject $
+                formatType' (ppeBody r) width typ
+            DisplayObject.MissingObject sh -> DisplayObject.MissingObject sh
+            DisplayObject.UserObject tm ->
+              DisplayObject.UserObject
+                . Pretty.render width
+                $ TermPrinter.prettyBinding (ppeBody r) n tm
   where
     ppeBody r =
       if suffixified suff
@@ -1139,41 +1176,57 @@ termsToSyntax suff width ppe0 terms =
         else PPE.declarationPPE ppe0 r
     ppeDecl =
       (if suffixified suff then PPED.suffixifiedPPE else PPED.unsuffixifiedPPE) ppe0
-    go ((n, r), dt) = (r,) $ case dt of
-      DisplayObject.BuiltinObject typ ->
-        DisplayObject.BuiltinObject $
-          formatType' (ppeBody r) width typ
-      DisplayObject.MissingObject sh -> DisplayObject.MissingObject sh
-      DisplayObject.UserObject tm ->
-        DisplayObject.UserObject
-          . Pretty.render width
-          $ TermPrinter.prettyBinding (ppeBody r) n tm
 
+-- | Version of 'typesToSyntax' which works over arbitrary traversals.
+--
+-- E.g.
+-- @@
+-- typesToSyntaxOf suff width pped traversed [(ref, dispObj)]
+--
+-- or
+--
+-- typesToSyntaxOf suff width pped id (ref, dispObj)
+--
+-- or
+--
+-- typesToSyntaxOf suff width pped Map.asList_ (Map.singleton ref dispObj)
+-- @@
+typesToSyntaxOf ::
+  (Var v) =>
+  (Ord a) =>
+  Suffixify ->
+  Width ->
+  PPED.PrettyPrintEnvDecl ->
+  Traversal s t (TypeReference, DisplayObject () (DD.Decl v a)) (TypeReference, DisplayObject SyntaxText SyntaxText) ->
+  s ->
+  t
+typesToSyntaxOf suff width ppe0 trav s =
+  s & over (unsafePartsOf trav) (typesToSyntax suff width ppe0)
+
+-- | Converts Type Display Objects into Syntax Text.
 typesToSyntax ::
   (Var v) =>
   (Ord a) =>
   Suffixify ->
   Width ->
   PPED.PrettyPrintEnvDecl ->
-  Map Reference.Reference (DisplayObject () (DD.Decl v a)) ->
-  Map Reference.Reference (DisplayObject SyntaxText SyntaxText)
+  [(TypeReference, (DisplayObject () (DD.Decl v a)))] ->
+  [(TypeReference, (DisplayObject SyntaxText SyntaxText))]
 typesToSyntax suff width ppe0 types =
-  Map.fromList $
-    map go . Map.toList $
-      Map.mapKeys
-        (first (PPE.typeName ppeDecl) . dupe)
-        types
+  types
+    <&> \(r, dispObj) ->
+      let n = PPE.typeName ppeDecl r
+       in (r,) $ case dispObj of
+            BuiltinObject _ -> BuiltinObject (formatTypeName' ppeDecl r)
+            MissingObject sh -> MissingObject sh
+            UserObject d ->
+              UserObject . Pretty.render width $
+                DeclPrinter.prettyDecl (PPE.declarationPPEDecl ppe0 r) r n d
   where
     ppeDecl =
       if suffixified suff
         then PPED.suffixifiedPPE ppe0
         else PPED.unsuffixifiedPPE ppe0
-    go ((n, r), dt) = (r,) $ case dt of
-      BuiltinObject _ -> BuiltinObject (formatTypeName' ppeDecl r)
-      MissingObject sh -> MissingObject sh
-      UserObject d ->
-        UserObject . Pretty.render width $
-          DeclPrinter.prettyDecl (PPE.declarationPPEDecl ppe0 r) r n d
 
 -- | Renders a type to its decl header, e.g.
 --

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

@@ -0,0 +1,63 @@
+-- | Utilities for displaying diffs between definitions.
+module Unison.Server.Backend.DefinitionDiff
+  ( diffDisplayObjects,
+  )
+where
+
+import Data.Algorithm.Diff qualified as Diff
+import Data.Foldable qualified as Foldable
+import Data.Function
+import Data.List qualified as List
+import Unison.Codebase.Editor.DisplayObject (DisplayObject (..))
+import Unison.Prelude
+import Unison.Server.Syntax (SyntaxText)
+import Unison.Server.Syntax qualified as Syntax
+import Unison.Server.Types (DisplayObjectDiff (..), SemanticSyntaxDiff (..))
+import Unison.Util.AnnotatedText (AnnotatedText (..))
+import Unison.Util.AnnotatedText qualified as AT
+
+diffDisplayObjects :: HasCallStack => DisplayObject SyntaxText SyntaxText -> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff
+diffDisplayObjects from to = case (from, to) of
+  (BuiltinObject fromST, BuiltinObject toST) -> DisplayObjectDiff (BuiltinObject (diffSyntaxText fromST toST))
+  (MissingObject fromSH, MissingObject toSH)
+    | fromSH == toSH -> DisplayObjectDiff (MissingObject fromSH)
+    | otherwise -> MismatchedDisplayObjects (MissingObject fromSH) (MissingObject toSH)
+  (UserObject fromST, UserObject toST) -> DisplayObjectDiff (UserObject (diffSyntaxText fromST toST))
+  (l, r) -> MismatchedDisplayObjects l r
+
+diffSyntaxText :: SyntaxText -> SyntaxText -> [SemanticSyntaxDiff]
+diffSyntaxText (AnnotatedText fromST) (AnnotatedText toST) =
+  Diff.getGroupedDiffBy
+    diffEq
+    (Foldable.toList @Seq fromST)
+    (Foldable.toList @Seq toST)
+    & expandSpecialCases
+  where
+    -- We special-case situations where the name of a definition changed but its hash didn't;
+    -- and cases where the name didn't change but the hash did.
+    -- So, we treat these elements as equal then detect them in a post-processing step.
+    diffEq :: AT.Segment Syntax.Element -> AT.Segment Syntax.Element -> Bool
+    diffEq (AT.Segment {segment = fromSegment, annotation = fromAnnotation}) (AT.Segment {segment = toSegment, annotation = toAnnotation}) =
+      fromSegment == toSegment || fromAnnotation == toAnnotation
+
+    expandSpecialCases :: [Diff.Diff [AT.Segment (Syntax.Element)]] -> [SemanticSyntaxDiff]
+    expandSpecialCases xs =
+      xs
+        & foldMap \case
+          Diff.First ys -> [Old ys]
+          Diff.Second ys -> [New ys]
+          Diff.Both from to ->
+            -- Each list should always be the same length.
+            zipWith detectSpecialCase from to
+              & (flip List.foldr [])
+                ( \next acc -> case (acc, next) of
+                    (Both xs : rest, Left seg) -> Both (seg : xs) : rest
+                    (_, Left seg) -> Both [seg] : acc
+                    (_, Right diff) -> diff : acc
+                )
+    detectSpecialCase :: AT.Segment Syntax.Element -> AT.Segment Syntax.Element -> Either (AT.Segment Syntax.Element) SemanticSyntaxDiff
+    detectSpecialCase fromSegment toSegment
+      | fromSegment == toSegment = Left fromSegment
+      | AT.annotation fromSegment == AT.annotation toSegment = Right (SegmentChange (AT.segment fromSegment, AT.segment toSegment) (AT.annotation fromSegment))
+      | AT.segment fromSegment == AT.segment toSegment = Right (AnnotationChange (AT.segment fromSegment) (AT.annotation fromSegment, AT.annotation toSegment))
+      | otherwise = error "diffSyntaxText: found Syntax Elements in 'both' which have nothing in common."

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

@@ -48,6 +48,7 @@ import Servant
     serve,
     throwError,
   )
+import Servant qualified as Servant
 import Servant.API
   ( Accept (..),
     Capture,
@@ -60,11 +61,13 @@ import Servant.API
   )
 import Servant.Docs
   ( DocIntro (DocIntro),
+    ToParam (..),
     ToSample (..),
     docsWithIntros,
     markdown,
     singleSample,
   )
+import Servant.Docs qualified as Servant
 import Servant.OpenApi (HasOpenApi (toOpenApi))
 import Servant.Server
   ( Application,
@@ -85,17 +88,24 @@ import System.Random.MWC (createSystemRandom)
 import U.Codebase.HashTags (CausalHash)
 import Unison.Codebase (Codebase)
 import Unison.Codebase qualified as Codebase
+import Unison.Codebase.Branch qualified as Branch
+import Unison.Codebase.Branch.Names qualified as Branch
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Runtime qualified as Rt
-import Unison.Codebase.ShortCausalHash (ShortCausalHash)
 import Unison.HashQualified
+import Unison.HashQualified qualified as HQ
 import Unison.Name as Name (Name, segments)
 import Unison.Parser.Ann (Ann)
 import Unison.Prelude
+import Unison.PrettyPrintEnv.Names qualified as PPE
+import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
+import Unison.PrettyPrintEnvDecl.Names qualified as PPED
 import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
 import Unison.Server.Backend (Backend, BackendEnv, runBackend)
 import Unison.Server.Backend qualified as Backend
+import Unison.Server.Backend.DefinitionDiff qualified as DefinitionDiff
 import Unison.Server.Errors (backendError)
+import Unison.Server.Local.Definitions qualified as Defn
 import Unison.Server.Local.Endpoints.DefinitionSummary (TermSummaryAPI, TypeSummaryAPI, serveTermSummary, serveTypeSummary)
 import Unison.Server.Local.Endpoints.FuzzyFind (FuzzyFindAPI, serveFuzzyFind)
 import Unison.Server.Local.Endpoints.GetDefinitions
@@ -106,10 +116,17 @@ import Unison.Server.Local.Endpoints.NamespaceDetails qualified as NamespaceDeta
 import Unison.Server.Local.Endpoints.NamespaceListing qualified as NamespaceListing
 import Unison.Server.Local.Endpoints.Projects (ListProjectBranchesEndpoint, ListProjectsEndpoint, projectBranchListingEndpoint, projectListingEndpoint)
 import Unison.Server.Local.Endpoints.UCM (UCMAPI, ucmServer)
-import Unison.Server.Types (mungeString, setCacheControl)
+import Unison.Server.NameSearch (NameSearch (..))
+import Unison.Server.NameSearch.FromNames qualified as Names
+import Unison.Server.Types (TermDefinition (..), TermDiffResponse (..), TypeDefinition (..), TypeDiffResponse (..), mungeString, setCacheControl)
 import Unison.ShortHash qualified as ShortHash
+import Unison.Sqlite qualified as Sqlite
 import Unison.Symbol (Symbol)
 import Unison.Syntax.NameSegment qualified as NameSegment
+import Unison.Util.Pretty qualified as Pretty
+
+-- | Fail the route with a reasonable error if the query param is missing.
+type RequiredQueryParam = Servant.QueryParam' '[Servant.Required, Servant.Strict]
 
 -- HTML content type
 data HTML = HTML
@@ -143,8 +160,51 @@ type CodebaseServerAPI =
 
 type ProjectsAPI =
   ListProjectsEndpoint
-    :<|> (Capture "project-name" ProjectName :> "branches" :> ListProjectBranchesEndpoint)
-    :<|> (Capture "project-name" ProjectName :> "branches" :> Capture "branch-name" ProjectBranchName :> CodebaseServerAPI)
+    :<|> ( Capture "project-name" ProjectName
+             :> ( ( "branches"
+                      :> ( ListProjectBranchesEndpoint
+                             :<|> (Capture "branch-name" ProjectBranchName :> CodebaseServerAPI)
+                         )
+                  )
+                    :<|> ( "diff"
+                             :> ( "terms" :> ProjectDiffTermsEndpoint
+                                    :<|> "types" :> ProjectDiffTypesEndpoint
+                                )
+                         )
+                )
+         )
+
+type ProjectDiffTermsEndpoint =
+  RequiredQueryParam "oldBranchRef" ProjectBranchName
+    :> RequiredQueryParam "newBranchRef" ProjectBranchName
+    :> RequiredQueryParam "oldTerm" Name
+    :> RequiredQueryParam "newTerm" Name
+    :> Get '[JSON] TermDiffResponse
+
+type ProjectDiffTypesEndpoint =
+  RequiredQueryParam "oldBranchRef" ProjectBranchName
+    :> RequiredQueryParam "newBranchRef" ProjectBranchName
+    :> RequiredQueryParam "oldType" Name
+    :> RequiredQueryParam "newType" Name
+    :> Get '[JSON] TypeDiffResponse
+
+instance ToParam (Servant.QueryParam' mods "oldBranchRef" a) where
+  toParam _ = Servant.DocQueryParam "oldBranchRef" ["main"] "The name of the old branch" Servant.Normal
+
+instance ToParam (Servant.QueryParam' mods "newBranchRef" a) where
+  toParam _ = Servant.DocQueryParam "newBranchRef" ["main"] "The name of the new branch" Servant.Normal
+
+instance ToParam (Servant.QueryParam' mods "oldTerm" a) where
+  toParam _ = Servant.DocQueryParam "oldTerm" ["main"] "The name of the old term" Servant.Normal
+
+instance ToParam (Servant.QueryParam' mods "newTerm" a) where
+  toParam _ = Servant.DocQueryParam "newTerm" ["main"] "The name of the new term" Servant.Normal
+
+instance ToParam (Servant.QueryParam' mods "oldType" a) where
+  toParam _ = Servant.DocQueryParam "oldType" ["main"] "The name of the old type" Servant.Normal
+
+instance ToParam (Servant.QueryParam' mods "newType" a) where
+  toParam _ = Servant.DocQueryParam "newType" ["main"] "The name of the new type" Servant.Normal
 
 type WebUI = CaptureAll "route" Text :> Get '[HTML] RawHtml
 
@@ -529,40 +589,94 @@ serveProjectsCodebaseServerAPI codebase rt projectName branchName = do
   where
     projectAndBranchName = ProjectAndBranch projectName branchName
     namespaceListingEndpoint _rootParam rel name = do
-      root <- resolveProjectRoot
-      setCacheControl <$> NamespaceListing.serve codebase (Just root) rel name
+      root <- resolveProjectRoot codebase projectAndBranchName
+      setCacheControl <$> NamespaceListing.serve codebase (Just . Right $ root) rel name
     namespaceDetailsEndpoint namespaceName _rootParam renderWidth = do
-      root <- resolveProjectRoot
-      setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Just root) renderWidth
+      root <- resolveProjectRoot codebase projectAndBranchName
+      setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Just . Right $ root) renderWidth
 
     serveDefinitionsEndpoint _rootParam relativePath rawHqns renderWidth suff = do
-      root <- resolveProjectRoot
-      setCacheControl <$> serveDefinitions rt codebase (Just root) relativePath rawHqns renderWidth suff
+      root <- resolveProjectRoot codebase projectAndBranchName
+      setCacheControl <$> serveDefinitions rt codebase (Just . Right $ root) relativePath rawHqns renderWidth suff
 
     serveFuzzyFindEndpoint _rootParam relativePath limit renderWidth query = do
-      root <- resolveProjectRoot
-      setCacheControl <$> serveFuzzyFind codebase (Just root) relativePath limit renderWidth query
+      root <- resolveProjectRoot codebase projectAndBranchName
+      setCacheControl <$> serveFuzzyFind codebase (Just . Right $ root) relativePath limit renderWidth query
 
     serveTermSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do
-      root <- resolveProjectRoot
-      setCacheControl <$> serveTermSummary codebase shortHash mayName (Just root) relativeTo renderWidth
+      root <- resolveProjectRoot codebase projectAndBranchName
+      setCacheControl <$> serveTermSummary codebase shortHash mayName (Just . Right $ root) relativeTo renderWidth
 
     serveTypeSummaryEndpoint shortHash mayName _rootParam relativeTo renderWidth = do
-      root <- resolveProjectRoot
-      setCacheControl <$> serveTypeSummary codebase shortHash mayName (Just root) relativeTo renderWidth
+      root <- resolveProjectRoot codebase projectAndBranchName
+      setCacheControl <$> serveTypeSummary codebase shortHash mayName (Just . Right $ root) relativeTo renderWidth
 
-    resolveProjectRoot :: Backend IO (Either ShortCausalHash CausalHash)
-    resolveProjectRoot = do
-      mayCH <- liftIO . Codebase.runTransaction codebase $ Backend.causalHashForProjectBranchName @IO projectAndBranchName
-      case mayCH of
-        Nothing -> throwError (Backend.ProjectBranchNameNotFound projectName branchName)
-        Just ch -> pure (Right ch)
+resolveProjectRoot :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO CausalHash
+resolveProjectRoot codebase projectAndBranchName@(ProjectAndBranch projectName branchName) = do
+  mayCH <- liftIO . Codebase.runTransaction codebase $ Backend.causalHashForProjectBranchName @IO projectAndBranchName
+  case mayCH of
+    Nothing -> throwError (Backend.ProjectBranchNameNotFound projectName branchName)
+    Just ch -> pure ch
+
+serveProjectDiffTermsEndpoint :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> ProjectName -> ProjectBranchName -> ProjectBranchName -> Name -> Name -> Backend IO TermDiffResponse
+serveProjectDiffTermsEndpoint codebase rt projectName oldBranchRef newBranchRef oldTerm newTerm = do
+  (oldPPED, oldNameSearch) <- contextForProjectBranch codebase projectName oldBranchRef
+  (newPPED, newNameSearch) <- contextForProjectBranch codebase projectName newBranchRef
+  oldTerm@TermDefinition {termDefinition = oldTermDispObject} <- Defn.termDefinitionByName codebase oldPPED oldNameSearch width rt oldTerm `whenNothingM` throwError (Backend.NoSuchDefinition (HQ.NameOnly oldTerm))
+  newTerm@TermDefinition {termDefinition = newTermDisplayObj} <- Defn.termDefinitionByName codebase newPPED newNameSearch width rt newTerm `whenNothingM` throwError (Backend.NoSuchDefinition (HQ.NameOnly newTerm))
+  let termDiffDisplayObject = DefinitionDiff.diffDisplayObjects oldTermDispObject newTermDisplayObj
+  pure
+    TermDiffResponse
+      { project = projectName,
+        oldBranch = oldBranchRef,
+        newBranch = newBranchRef,
+        oldTerm = oldTerm,
+        newTerm = newTerm,
+        diff = termDiffDisplayObject
+      }
+  where
+    width = Pretty.Width 80
+
+contextForProjectBranch :: (Codebase IO v a) -> ProjectName -> ProjectBranchName -> Backend IO (PrettyPrintEnvDecl, NameSearch Sqlite.Transaction)
+contextForProjectBranch codebase projectName branchName = do
+  projectRootHash <- resolveProjectRoot codebase (ProjectAndBranch projectName branchName)
+  projectRootBranch <- liftIO $ Codebase.expectBranchForHash codebase projectRootHash
+  hashLength <- liftIO $ Codebase.runTransaction codebase $ Codebase.hashLength
+  let names = Branch.toNames (Branch.head projectRootBranch)
+  let pped = PPED.makePPED (PPE.hqNamer hashLength names) (PPE.suffixifyByHash names)
+  let nameSearch = Names.makeNameSearch hashLength names
+  pure (pped, nameSearch)
+
+serveProjectDiffTypesEndpoint :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> ProjectName -> ProjectBranchName -> ProjectBranchName -> Name -> Name -> Backend IO TypeDiffResponse
+serveProjectDiffTypesEndpoint codebase rt projectName oldBranchRef newBranchRef oldType newType = do
+  (oldPPED, oldNameSearch) <- contextForProjectBranch codebase projectName oldBranchRef
+  (newPPED, newNameSearch) <- contextForProjectBranch codebase projectName newBranchRef
+  oldType@TypeDefinition {typeDefinition = oldTypeDispObj} <- Defn.typeDefinitionByName codebase oldPPED oldNameSearch width rt oldType `whenNothingM` throwError (Backend.NoSuchDefinition (HQ.NameOnly oldType))
+  newType@TypeDefinition {typeDefinition = newTypeDisplayObj} <- Defn.typeDefinitionByName codebase newPPED newNameSearch width rt newType `whenNothingM` throwError (Backend.NoSuchDefinition (HQ.NameOnly newType))
+  let typeDiffDisplayObject = DefinitionDiff.diffDisplayObjects oldTypeDispObj newTypeDisplayObj
+  pure
+    TypeDiffResponse
+      { project = projectName,
+        oldBranch = oldBranchRef,
+        newBranch = newBranchRef,
+        oldType = oldType,
+        newType = newType,
+        diff = typeDiffDisplayObject
+      }
+  where
+    width = Pretty.Width 80
 
 serveProjectsAPI :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> ServerT ProjectsAPI (Backend IO)
 serveProjectsAPI codebase rt =
   projectListingEndpoint codebase
-    :<|> projectBranchListingEndpoint codebase
-    :<|> serveProjectsCodebaseServerAPI codebase rt
+    :<|> ( \projectName ->
+             ( projectBranchListingEndpoint codebase projectName
+                 :<|> serveProjectsCodebaseServerAPI codebase rt projectName
+             )
+               :<|> ( serveProjectDiffTermsEndpoint codebase rt projectName
+                        :<|> serveProjectDiffTypesEndpoint codebase rt projectName
+                    )
+         )
 
 serveUnisonLocal ::
   BackendEnv ->

unison-share-api/src/Unison/Server/Local/Definitions.hs

@@ -1,16 +1,28 @@
-module Unison.Server.Local.Definitions (prettyDefinitionsForHQName) where
+module Unison.Server.Local.Definitions
+  ( prettyDefinitionsForHQName,
+    termDefinitionByName,
+    typeDefinitionByName,
+  )
+where
 
 import Control.Lens hiding ((??))
 import Control.Monad.Except
+import Control.Monad.Trans.Maybe (mapMaybeT)
 import Data.Map qualified as Map
+import Data.Set.NonEmpty qualified as NESet
 import U.Codebase.Branch qualified as V2Branch
 import U.Codebase.Causal qualified as V2Causal
+import U.Codebase.Reference (TermReference, TypeReference)
 import Unison.Codebase (Codebase)
 import Unison.Codebase qualified as Codebase
+import Unison.Codebase.Editor.DisplayObject (DisplayObject)
 import Unison.Codebase.Path (Path)
 import Unison.Codebase.Runtime qualified as Rt
+import Unison.DataDeclaration qualified as DD
 import Unison.HashQualified qualified as HQ
+import Unison.HashQualified' qualified as HQ'
 import Unison.Name (Name)
+import Unison.NamesWithHistory qualified as NS
 import Unison.NamesWithHistory qualified as Names
 import Unison.Parser.Ann (Ann)
 import Unison.Prelude
@@ -19,13 +31,20 @@ import Unison.PrettyPrintEnvDecl qualified as PPED
 import Unison.Reference qualified as Reference
 import Unison.Referent qualified as Referent
 import Unison.Server.Backend
+import Unison.Server.Backend qualified as Backend
 import Unison.Server.Doc qualified as Doc
 import Unison.Server.Local qualified as Local
+import Unison.Server.NameSearch (NameSearch)
+import Unison.Server.NameSearch qualified as NS
+import Unison.Server.NameSearch qualified as NameSearch
 import Unison.Server.NameSearch.FromNames (makeNameSearch)
 import Unison.Server.Types
 import Unison.Sqlite qualified as Sqlite
 import Unison.Symbol (Symbol)
 import Unison.Syntax.HashQualified qualified as HQ (toText)
+import Unison.Term (Term)
+import Unison.Type (Type)
+import Unison.Util.Map qualified as Map
 import Unison.Util.Pretty (Width)
 
 -- | Renders a definition for the given name or hash alongside its documentation.
@@ -70,19 +89,19 @@ prettyDefinitionsForHQName perspective shallowRoot renderWidth suffixifyBindings
   let width = mayDefaultWidth renderWidth
   let docResults :: Name -> IO [(HashQualifiedName, UnisonHash, Doc.Doc)]
       docResults name = do
-        docRefs <- docsForDefinitionName codebase nameSearch Names.ExactName name
+        docRefs <- Codebase.runTransaction codebase $ docsForDefinitionName codebase nameSearch Names.ExactName name
         renderDocRefs pped width codebase rt docRefs
           -- local server currently ignores doc eval errors
           <&> fmap \(hqn, h, doc, _errs) -> (hqn, h, doc)
 
   let fqnPPE = PPED.unsuffixifiedPPE pped
   typeDefinitions <-
-    ifor (typesToSyntax suffixifyBindings width pped types) \ref tp -> do
+    ifor (typesToSyntaxOf suffixifyBindings width pped (Map.asList_ . traversed) types) \ref tp -> do
       let hqTypeName = PPE.typeNameOrHashOnly fqnPPE ref
       docs <- liftIO $ (maybe (pure []) docResults (HQ.toName hqTypeName))
       mkTypeDefinition codebase pped width ref docs tp
   termDefinitions <-
-    ifor (termsToSyntax suffixifyBindings width pped terms) \reference trm -> do
+    ifor (termsToSyntaxOf suffixifyBindings width pped (Map.asList_ . traversed) terms) \reference trm -> do
       let referent = Referent.Ref reference
       let hqTermName = PPE.termNameOrHashOnly fqnPPE referent
       docs <- liftIO $ (maybe (pure []) docResults (HQ.toName hqTermName))
@@ -95,3 +114,66 @@ prettyDefinitionsForHQName perspective shallowRoot renderWidth suffixifyBindings
       renderedDisplayTerms
       renderedDisplayTypes
       renderedMisses
+
+-- | Find the term referenced by the given name and return a display object for it.
+termDisplayObjectByName :: Codebase m Symbol Ann -> NameSearch Sqlite.Transaction -> Name -> Sqlite.Transaction (Maybe (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
+termDisplayObjectByName codebase nameSearch name = runMaybeT do
+  refs <- lift $ NameSearch.lookupRelativeHQRefs' (NS.termSearch nameSearch) NS.ExactName (HQ'.NameOnly name)
+  ref <- fmap NESet.findMin . hoistMaybe $ NESet.nonEmptySet refs
+  case ref of
+    Referent.Ref r -> (r,) <$> lift (Backend.displayTerm codebase r)
+    Referent.Con _ _ ->
+      -- TODO: Should we error here or some other sensible thing rather than returning no
+      -- result?
+      empty
+
+termDefinitionByName ::
+  Codebase IO Symbol Ann ->
+  PPED.PrettyPrintEnvDecl ->
+  NameSearch Sqlite.Transaction ->
+  Width ->
+  Rt.Runtime Symbol ->
+  Name ->
+  Backend IO (Maybe TermDefinition)
+termDefinitionByName codebase pped nameSearch width rt name = runMaybeT $ do
+  let biasedPPED = PPED.biasTo [name] pped
+  (ref, displayObject, docRefs) <- mapMaybeT (liftIO . Codebase.runTransaction codebase) $ do
+    (ref, displayObject) <- MaybeT $ termDisplayObjectByName codebase nameSearch name
+    docRefs <- lift $ Backend.docsForDefinitionName codebase nameSearch NS.ExactName name
+    pure (ref, displayObject, docRefs)
+  renderedDocs <-
+    liftIO $
+      renderDocRefs pped width codebase rt docRefs
+        -- local server currently ignores doc eval errors
+        <&> fmap \(hqn, h, doc, _errs) -> (hqn, h, doc)
+  let (_ref, syntaxDO) = Backend.termsToSyntaxOf (Suffixify False) width pped id (ref, displayObject)
+  lift $ Backend.mkTermDefinition codebase biasedPPED width ref renderedDocs syntaxDO
+
+-- | Find the type referenced by the given name and return a display object for it.
+typeDisplayObjectByName :: Codebase m Symbol Ann -> NameSearch Sqlite.Transaction -> Name -> Sqlite.Transaction (Maybe (TypeReference, DisplayObject () (DD.Decl Symbol Ann)))
+typeDisplayObjectByName codebase nameSearch name = runMaybeT do
+  refs <- lift $ NameSearch.lookupRelativeHQRefs' (NS.typeSearch nameSearch) NS.ExactName (HQ'.NameOnly name)
+  ref <- fmap NESet.findMin . hoistMaybe $ NESet.nonEmptySet refs
+  fmap (ref,) . lift $ Backend.displayType codebase ref
+
+typeDefinitionByName ::
+  Codebase IO Symbol Ann ->
+  PPED.PrettyPrintEnvDecl ->
+  NameSearch Sqlite.Transaction ->
+  Width ->
+  Rt.Runtime Symbol ->
+  Name ->
+  Backend IO (Maybe TypeDefinition)
+typeDefinitionByName codebase pped nameSearch width rt name = runMaybeT $ do
+  let biasedPPED = PPED.biasTo [name] pped
+  (ref, displayObject, docRefs) <- mapMaybeT (liftIO . Codebase.runTransaction codebase) $ do
+    (ref, displayObject) <- MaybeT $ typeDisplayObjectByName codebase nameSearch name
+    docRefs <- lift $ Backend.docsForDefinitionName codebase nameSearch NS.ExactName name
+    pure (ref, displayObject, docRefs)
+  renderedDocs <-
+    liftIO $
+      renderDocRefs pped width codebase rt docRefs
+        -- local server currently ignores doc eval errors
+        <&> fmap \(hqn, h, doc, _errs) -> (hqn, h, doc)
+  let (_ref, syntaxDO) = Backend.typesToSyntaxOf (Suffixify False) width pped id (ref, displayObject)
+  lift $ Backend.mkTypeDefinition codebase biasedPPED width ref renderedDocs syntaxDO

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

@@ -38,15 +38,16 @@ import U.Codebase.HashTags
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Editor.DisplayObject (DisplayObject)
 import Unison.Codebase.Path qualified as Path
+import Unison.Core.Project (ProjectBranchName)
 import Unison.Hash qualified as Hash
 import Unison.HashQualified qualified as HQ
 import Unison.HashQualified' qualified as HQ'
 import Unison.Name (Name)
 import Unison.Prelude
-import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName)
+import Unison.Project (ProjectAndBranch, ProjectName)
 import Unison.Server.Doc (Doc)
 import Unison.Server.Orphans ()
-import Unison.Server.Syntax (SyntaxText)
+import Unison.Server.Syntax qualified as Syntax
 import Unison.ShortHash (ShortHash)
 import Unison.Syntax.HashQualified qualified as HQ (parseText)
 import Unison.Syntax.Name qualified as Name
@@ -191,6 +192,20 @@ instance ToJSON DefinitionDisplayResults where
 
 deriving instance ToSchema DefinitionDisplayResults
 
+data TermDefinitionDiff = TermDefinitionDiff
+  { left :: TermDefinition,
+    right :: TermDefinition,
+    diff :: DisplayObjectDiff
+  }
+  deriving (Eq, Show, Generic)
+
+data TypeDefinitionDiff = TypeDefinitionDiff
+  { left :: TypeDefinition,
+    right :: TypeDefinition,
+    diff :: DisplayObjectDiff
+  }
+  deriving (Eq, Show, Generic)
+
 newtype Suffixify = Suffixify {suffixified :: Bool}
   deriving (Eq, Ord, Show, Generic)
 
@@ -198,8 +213,8 @@ data TermDefinition = TermDefinition
   { termNames :: [HashQualifiedName],
     bestTermName :: HashQualifiedName,
     defnTermTag :: TermTag,
-    termDefinition :: DisplayObject SyntaxText SyntaxText,
-    signature :: SyntaxText,
+    termDefinition :: DisplayObject Syntax.SyntaxText Syntax.SyntaxText,
+    signature :: Syntax.SyntaxText,
     termDocs :: [(HashQualifiedName, UnisonHash, Doc)]
   }
   deriving (Eq, Show, Generic)
@@ -208,7 +223,7 @@ data TypeDefinition = TypeDefinition
   { typeNames :: [HashQualifiedName],
     bestTypeName :: HashQualifiedName,
     defnTypeTag :: TypeTag,
-    typeDefinition :: DisplayObject SyntaxText SyntaxText,
+    typeDefinition :: DisplayObject Syntax.SyntaxText Syntax.SyntaxText,
     typeDocs :: [(HashQualifiedName, UnisonHash, Doc)]
   }
   deriving (Eq, Show, Generic)
@@ -233,6 +248,64 @@ data TermTag = Doc | Test | Plain | Constructor TypeTag
 data TypeTag = Ability | Data
   deriving (Eq, Ord, Show, Generic)
 
+-- | A type for semantic diffing of definitions.
+-- Includes special-cases for when the name in a definition has changed but the hash hasn't
+-- (rename/alias), and when the hash has changed but the name hasn't (update propagation).
+data SemanticSyntaxDiff
+  = Old [Syntax.SyntaxSegment]
+  | New [Syntax.SyntaxSegment]
+  | Both [Syntax.SyntaxSegment]
+  | --  (fromSegment, toSegment) (shared annotation)
+    SegmentChange (String, String) (Maybe Syntax.Element)
+  | -- (shared segment) (fromAnnotation, toAnnotation)
+    AnnotationChange String (Maybe Syntax.Element, Maybe Syntax.Element)
+  deriving (Eq, Show, Generic)
+
+deriving instance ToSchema SemanticSyntaxDiff
+
+instance ToJSON SemanticSyntaxDiff where
+  toJSON = \case
+    Old segments ->
+      object
+        [ "diffTag" .= ("old" :: Text),
+          "elements" .= segments
+        ]
+    New segments ->
+      object
+        [ "diffTag" .= ("new" :: Text),
+          "elements" .= segments
+        ]
+    Both segments ->
+      object
+        [ "diffTag" .= ("both" :: Text),
+          "elements" .= segments
+        ]
+    SegmentChange (fromSegment, toSegment) annotation ->
+      object
+        [ "diffTag" .= ("segmentChange" :: Text),
+          "fromSegment" .= fromSegment,
+          "toSegment" .= toSegment,
+          "annotation" .= annotation
+        ]
+    AnnotationChange segment (fromAnnotation, toAnnotation) ->
+      object
+        [ "diffTag" .= ("annotationChange" :: Text),
+          "segment" .= segment,
+          "fromAnnotation" .= fromAnnotation,
+          "toAnnotation" .= toAnnotation
+        ]
+
+-- | A diff of the syntax of a term or type
+--
+-- It doesn't make sense to diff builtins with ABTs, so in that case we just provide the
+-- undiffed syntax.
+data DisplayObjectDiff
+  = DisplayObjectDiff (DisplayObject [SemanticSyntaxDiff] [SemanticSyntaxDiff])
+  | MismatchedDisplayObjects (DisplayObject Syntax.SyntaxText Syntax.SyntaxText) (DisplayObject Syntax.SyntaxText Syntax.SyntaxText)
+  deriving stock (Show, Eq, Generic)
+
+deriving instance ToSchema DisplayObjectDiff
+
 data UnisonRef
   = TypeRef UnisonHash
   | TermRef UnisonHash
@@ -247,7 +320,7 @@ data NamedTerm = NamedTerm
   { -- The name of the term, should be hash qualified if conflicted, otherwise name only.
     termName :: HQ'.HashQualified Name,
     termHash :: ShortHash,
-    termType :: Maybe SyntaxText,
+    termType :: Maybe Syntax.SyntaxText,
     termTag :: TermTag
   }
   deriving (Eq, Generic, Show)
@@ -391,3 +464,79 @@ instance Docs.ToCapture (Capture "project-and-branch" ProjectBranchNameParam) wh
     DocCapture
       "project-and-branch"
       "The name of a project and branch e.g. `@unison%2Fbase%2Fmain` or `@unison%2Fbase%2F@runarorama%2Fmain`"
+
+data TermDiffResponse = TermDiffResponse
+  { project :: ProjectName,
+    oldBranch :: ProjectBranchName,
+    newBranch :: ProjectBranchName,
+    oldTerm :: TermDefinition,
+    newTerm :: TermDefinition,
+    diff :: DisplayObjectDiff
+  }
+  deriving (Eq, Show, Generic)
+
+deriving instance ToSchema TermDiffResponse
+
+instance Docs.ToSample TermDiffResponse where
+  toSamples _ = []
+
+instance ToJSON TermDiffResponse where
+  toJSON (TermDiffResponse {diff, project, oldBranch, newBranch, oldTerm, newTerm}) =
+    case diff of
+      DisplayObjectDiff dispDiff ->
+        object
+          [ "diff" .= dispDiff,
+            "diffKind" .= ("diff" :: Text),
+            "project" .= project,
+            "oldBranchRef" .= oldBranch,
+            "newBranchRef" .= newBranch,
+            "oldTerm" .= oldTerm,
+            "newTerm" .= newTerm
+          ]
+      MismatchedDisplayObjects {} ->
+        object
+          [ "diffKind" .= ("mismatched" :: Text),
+            "project" .= project,
+            "oldBranchRef" .= oldBranch,
+            "newBranchRef" .= newBranch,
+            "oldTerm" .= oldTerm,
+            "newTerm" .= newTerm
+          ]
+
+data TypeDiffResponse = TypeDiffResponse
+  { project :: ProjectName,
+    oldBranch :: ProjectBranchName,
+    newBranch :: ProjectBranchName,
+    oldType :: TypeDefinition,
+    newType :: TypeDefinition,
+    diff :: DisplayObjectDiff
+  }
+  deriving (Eq, Show, Generic)
+
+deriving instance ToSchema TypeDiffResponse
+
+instance Docs.ToSample TypeDiffResponse where
+  toSamples _ = []
+
+instance ToJSON TypeDiffResponse where
+  toJSON (TypeDiffResponse {diff, project, oldBranch, newBranch, oldType, newType}) =
+    case diff of
+      DisplayObjectDiff dispDiff ->
+        object
+          [ "diff" .= dispDiff,
+            "diffKind" .= ("diff" :: Text),
+            "project" .= project,
+            "oldBranchRef" .= oldBranch,
+            "newBranchRef" .= newBranch,
+            "oldType" .= oldType,
+            "newType" .= newType
+          ]
+      MismatchedDisplayObjects {} ->
+        object
+          [ "diffKind" .= ("mismatched" :: Text),
+            "project" .= project,
+            "oldBranchRef" .= oldBranch,
+            "newBranchRef" .= newBranch,
+            "oldType" .= oldType,
+            "newType" .= newType
+          ]

unison-share-api/unison-share-api.cabal

@@ -18,6 +18,7 @@ source-repository head
 library
   exposed-modules:
       Unison.Server.Backend
+      Unison.Server.Backend.DefinitionDiff
       Unison.Server.CodebaseServer
       Unison.Server.Doc
       Unison.Server.Doc.AsHtml
@@ -82,7 +83,8 @@ library
       ImportQualifiedPost
   ghc-options: -Wall
   build-depends:
-      NanoID
+      Diff
+    , NanoID
     , aeson >=2.0.0.0
     , async
     , base

unison-share-projects-api/src/Unison/Share/API/Projects.hs

@@ -34,6 +34,7 @@ module Unison.Share.API.Projects
     ProjectBranchIds (..),
     NotFound (..),
     Unauthorized (..),
+    BranchName,
   )
 where
 

unison-src/transcripts-manual/gen-racket-libs.md

@@ -5,7 +5,7 @@ Next, we'll download the jit project and generate a few Racket files from it.
 
 ```ucm
 .> project.create-empty jit-setup
-jit-setup/main> pull @unison/internal/releases/0.0.17 lib.jit
+jit-setup/main> lib.install @unison/internal/releases/0.0.17
 ```
 
 ```unison

unison-src/transcripts-using-base/fix3939.md

@@ -0,0 +1,12 @@
+```unison
+{{
+A simple doc.
+}}
+meh = 9
+```
+
+```ucm
+.> add
+.> find meh
+.> docs 1
+```

unison-src/transcripts-using-base/fix3939.output.md

@@ -0,0 +1,40 @@
+```unison
+{{
+A simple doc.
+}}
+meh = 9
+```
+
+```ucm
+
+  Loading changes detected in scratch.u.
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      meh     : Nat
+      meh.doc : Doc2
+
+```
+```ucm
+.> add
+
+  ⍟ I've added these definitions:
+  
+    meh     : Nat
+    meh.doc : Doc2
+
+.> find meh
+
+  1. meh : Nat
+  2. meh.doc : Doc2
+  
+
+.> docs 1
+
+  A simple doc.
+
+```

unison-src/transcripts/command-replace.md

@@ -1,58 +0,0 @@
-# Replace with terms and types
-
-Let's set up some definitions to start:
-
-```ucm:hide
-.lib> builtins.merge
-```
-
-```unison
-x = 1
-y = 2
-
-structural type X = One Nat
-structural type Y = Two Nat Nat
-```
-
-```ucm
-.> add
-```
-
-Test that replace works with terms
-```ucm
-.> replace x y
-.> view x
-```
-
-Test that replace works with types
-```ucm
-.> replace X Y
-.> find
-.> view.patch patch
-.> view X
-```
-
-Try with a type/term mismatch
-```ucm:error
-.> replace X x
-```
-```ucm:error
-.> replace y Y
-```
-
-Try with missing references
-```ucm:error
-.> replace X NOPE
-```
-```ucm:error
-.> replace y nope
-```
-```ucm:error
-.> replace nope X
-```
-```ucm:error
-.> replace nope y
-```
-```ucm:error
-.> replace nope nope
-```

unison-src/transcripts/command-replace.output.md

@@ -1,146 +0,0 @@
-# Replace with terms and types
-
-Let's set up some definitions to start:
-
-```unison
-x = 1
-y = 2
-
-structural type X = One Nat
-structural type Y = Two Nat Nat
-```
-
-```ucm
-
-  Loading changes detected in scratch.u.
-
-  I found and typechecked these definitions in scratch.u. If you
-  do an `add` or `update`, here's how your codebase would
-  change:
-  
-    ⍟ These new definitions are ok to `add`:
-    
-      structural type X
-      structural type Y
-      x : Nat
-      y : Nat
-
-```
-```ucm
-.> add
-
-  ⍟ I've added these definitions:
-  
-    structural type X
-    structural type Y
-    x : Nat
-    y : Nat
-
-```
-Test that replace works with terms
-```ucm
-.> replace x y
-
-  Done.
-
-.> view x
-
-  x : Nat
-  x = 2
-
-```
-Test that replace works with types
-```ucm
-.> replace X Y
-
-  Done.
-
-.> find
-
-  1. structural type X
-  2. x : Nat
-  3. X.One : Nat -> Nat -> X
-  4. structural type Y
-  5. y : Nat
-  6. Y.Two : Nat -> Nat -> X
-  
-
-.> view.patch patch
-
-  Edited Types: 1. #68k40ra7l7 -> 3. X
-  
-  Edited Terms: 2. #gjmq673r1v -> 4. x
-  
-  Tip: To remove entries from a patch, use
-       delete.term-replacement or delete.type-replacement, as
-       appropriate.
-
-.> view X
-
-  structural type X = One Nat Nat
-
-```
-Try with a type/term mismatch
-```ucm
-.> replace X x
-
-  ⚠️
-  
-  I was expecting either two types or two terms but was given a type X and a term x.
-
-```
-```ucm
-.> replace y Y
-
-  ⚠️
-  
-  I was expecting either two types or two terms but was given a type Y and a term y.
-
-```
-Try with missing references
-```ucm
-.> replace X NOPE
-
-  ⚠️
-  
-  The following names were not found in the codebase. Check your spelling.
-    NOPE
-
-```
-```ucm
-.> replace y nope
-
-  ⚠️
-  
-  The following names were not found in the codebase. Check your spelling.
-    nope
-
-```
-```ucm
-.> replace nope X
-
-  ⚠️
-  
-  The following names were not found in the codebase. Check your spelling.
-    nope
-
-```
-```ucm
-.> replace nope y
-
-  ⚠️
-  
-  The following names were not found in the codebase. Check your spelling.
-    nope
-
-```
-```ucm
-.> replace nope nope
-
-  ⚠️
-  
-  The following names were not found in the codebase. Check your spelling.
-    nope
-    nope
-
-```

unison-src/transcripts/copy-patch.md

@@ -1,42 +0,0 @@
-# Test that copying a patch works as expected
-
-```unison:hide
-x = 1
-```
-
-```ucm
-.> add
-```
-
-Change the definition of `x` so something goes in our patch:
-
-```unison:hide
-x = 2
-```
-
-```ucm
-.> update.old foo.patch
-```
-
-Copy the patch and make sure it's still there.
-
-```ucm
-.> copy.patch foo.patch bar.patch
-.> ls foo
-.> view.patch foo.patch
-.> ls bar
-.> view.patch bar.patch
-```
-
-Now move the patch.
-
-```ucm
-.> move.patch foo.patch qux.patch
-```
-
-The moved patch should be gone.
-
-```ucm:error
-.> view.patch foo.patch
-.> ls foo
-```

unison-src/transcripts/copy-patch.output.md

@@ -1,80 +0,0 @@
-# Test that copying a patch works as expected
-
-```unison
-x = 1
-```
-
-```ucm
-.> add
-
-  ⍟ I've added these definitions:
-  
-    x : ##Nat
-
-```
-Change the definition of `x` so something goes in our patch:
-
-```unison
-x = 2
-```
-
-```ucm
-.> update.old foo.patch
-
-  ⍟ I've updated these names to your new definition:
-  
-    x : ##Nat
-
-```
-Copy the patch and make sure it's still there.
-
-```ucm
-.> copy.patch foo.patch bar.patch
-
-  Done.
-
-.> ls foo
-
-  1. patch (patch)
-
-.> view.patch foo.patch
-
-  Edited Terms: 1. #gjmq673r1v -> 2. x
-  
-  Tip: To remove entries from a patch, use
-       delete.term-replacement or delete.type-replacement, as
-       appropriate.
-
-.> ls bar
-
-  1. patch (patch)
-
-.> view.patch bar.patch
-
-  Edited Terms: 1. #gjmq673r1v -> 2. x
-  
-  Tip: To remove entries from a patch, use
-       delete.term-replacement or delete.type-replacement, as
-       appropriate.
-
-```
-Now move the patch.
-
-```ucm
-.> move.patch foo.patch qux.patch
-
-  Done.
-
-```
-The moved patch should be gone.
-
-```ucm
-.> view.patch foo.patch
-
-  This patch is empty.
-
-.> ls foo
-
-  nothing to show
-
-```