Update MoveTerm, MoveType, MoveBranch

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

@@ -26,6 +26,7 @@ import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Path (Path)
 import Unison.Codebase.Path qualified as Path
 import Unison.HashQualified' (HashQualified (HashQualified, NameOnly))
+import Unison.NameSegment (NameSegment)
 import Unison.Names (Names)
 import Unison.Names qualified as Names
 import Unison.Prelude
@@ -69,10 +70,10 @@ getBranch (p, seg) b = case Path.toList p of
     (Branch.head <$> Map.lookup h (b ^. Branch.children))
       >>= getBranch (Path.fromList p, seg)
 
-makeAddTermName :: Path.Split -> Referent -> (Path, Branch0 m -> Branch0 m)
+makeAddTermName :: (p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
 makeAddTermName (p, name) r = (p, Branch.addTermName r name)
 
-makeDeleteTermName :: Path.Split -> Referent -> (Path, Branch0 m -> Branch0 m)
+makeDeleteTermName :: (p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
 makeDeleteTermName (p, name) r = (p, Branch.deleteTermName r name)
 
 makeAnnihilateTermName :: Path.Split -> (Path, Branch0 m -> Branch0 m)
@@ -81,10 +82,10 @@ makeAnnihilateTermName (p, name) = (p, Branch.annihilateTermName name)
 makeAnnihilateTypeName :: Path.Split -> (Path, Branch0 m -> Branch0 m)
 makeAnnihilateTypeName (p, name) = (p, Branch.annihilateTypeName name)
 
-makeAddTypeName :: Path.Split -> Reference -> (Path, Branch0 m -> Branch0 m)
+makeAddTypeName :: (p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m)
 makeAddTypeName (p, name) r = (p, Branch.addTypeName r name)
 
-makeDeleteTypeName :: Path.Split -> Reference -> (Path, Branch0 m -> Branch0 m)
+makeDeleteTypeName :: (p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m)
 makeDeleteTypeName (p, name) r = (p, Branch.deleteTypeName r name)
 
 makeSetBranch :: Path.Split -> Branch m -> (Path, Branch0 m -> Branch0 m)

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

@@ -1,15 +1,20 @@
 -- | Utilities that have to do with constructing names objects.
 module Unison.Cli.NamesUtils
   ( currentNames,
+    projectRootNames,
   )
 where
 
 import Unison.Cli.Monad (Cli)
-import Unison.Cli.MonadUtils (getCurrentBranch0)
+import Unison.Cli.MonadUtils qualified as Cli
 import Unison.Codebase.Branch.Names qualified as Branch
 import Unison.Names (Names)
 
 -- | Produce a 'Names' object which contains names for the current branch.
 currentNames :: Cli Names
 currentNames = do
-  Branch.toNames <$> getCurrentBranch0
+  Branch.toNames <$> Cli.getCurrentBranch0
+
+projectRootNames :: Cli Names
+projectRootNames = do
+  Branch.toNames <$> Cli.getCurrentProjectRoot0

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

@@ -11,9 +11,9 @@ import Unison.Codebase.Path qualified as Path
 import Unison.HashQualified' qualified as HQ'
 import Unison.Prelude
 
-handleMoveAll :: Bool -> Path.Path' -> Path.Path' -> Text -> Cli ()
-handleMoveAll hasConfirmed src' dest' description = do
-  moveBranchFunc <- moveBranchFunc hasConfirmed src' dest'
+handleMoveAll :: Path.Path' -> Path.Path' -> Text -> Cli ()
+handleMoveAll src' dest' description = do
+  moveBranchFunc <- moveBranchFunc src' dest'
   moveTermTypeSteps <- case (,) <$> Path.toSplit' src' <*> Path.toSplit' dest' of
     Nothing -> pure []
     Just (fmap HQ'.NameOnly -> src, dest) -> do

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

@@ -7,17 +7,16 @@ import Unison.Codebase.Branch (Branch)
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Editor.Output (Output (..))
 import Unison.Codebase.Path qualified as Path
+import Unison.Codebase.ProjectPath qualified as PP
 import Unison.Prelude
 
-moveBranchFunc :: Bool -> Path.Path' -> Path.Path' -> Cli (Maybe (Path.Absolute, Branch IO -> Branch IO))
-moveBranchFunc hasConfirmed src' dest' = do
-  srcAbs <- Cli.resolvePath' src'
-  destAbs <- Cli.resolvePath' dest'
+moveBranchFunc :: Path.Path' -> Path.Path' -> Cli (Maybe (PP.ProjectPath, Branch IO -> Branch IO))
+moveBranchFunc src' dest' = do
+  -- We currently only support moving within the same project branch.
+  srcPP@(PP.ProjectPath proj projBranch srcAbs) <- Cli.resolvePath' src'
+  PP.ProjectPath _ _ destAbs <- Cli.resolvePath' dest'
   destBranchExists <- Cli.branchExistsAtPath' dest'
-  let isRootMove = (Path.isRoot srcAbs || Path.isRoot destAbs)
-  when (isRootMove && not hasConfirmed) do
-    Cli.returnEarly MoveRootBranchConfirmation
-  Cli.getMaybeBranchFromProjectRootPath srcAbs >>= traverse \srcBranch -> do
+  Cli.getMaybeBranchFromProjectPath srcPP >>= traverse \srcBranch -> do
     -- We want the move to appear as a single step in the root namespace, but we need to make
     -- surgical changes in both the root and the destination, so we make our modifications at the shared parent of
     -- those changes such that they appear as a single change in the root.
@@ -26,16 +25,16 @@ moveBranchFunc hasConfirmed src' dest' = do
           changeRoot
             & Branch.modifyAt srcLoc (const Branch.empty)
             & Branch.modifyAt destLoc (const srcBranch)
-    if (destBranchExists && not isRootMove)
+    if destBranchExists
       then Cli.respond (MovedOverExistingBranch dest')
       else pure ()
-    pure (Path.Absolute changeRootPath, doMove)
+    pure (PP.ProjectPath proj projBranch $ Path.Absolute changeRootPath, doMove)
 
 -- | Moves a branch and its history from one location to another, and saves the new root
 -- branch.
-doMoveBranch :: Text -> Bool -> Path.Path' -> Path.Path' -> Cli ()
-doMoveBranch actionDescription hasConfirmed src' dest' = do
-  moveBranchFunc hasConfirmed src' dest' >>= \case
+doMoveBranch :: Text -> Path.Path' -> Path.Path' -> Cli ()
+doMoveBranch actionDescription src' dest' = do
+  moveBranchFunc src' dest' >>= \case
     Nothing -> Cli.respond (BranchNotFound src')
     Just (path, func) -> do
       _ <- Cli.updateAt actionDescription path func

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

@@ -1,6 +1,6 @@
 module Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm, moveTermSteps) where
 
-import Control.Lens (_2)
+import Control.Lens (_1, _2)
 import Data.Set qualified as Set
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
@@ -34,7 +34,7 @@ moveTermSteps src' dest' = do
       pure
         [ -- Mitchell: throwing away any hash-qualification here seems wrong!
           BranchUtil.makeDeleteTermName (over _2 HQ'.toName p) srcTerm,
-          BranchUtil.makeAddTermName (Path.convert dest) srcTerm
+          BranchUtil.makeAddTermName (over _1 (view PP.absPath_) dest) srcTerm
         ]
 
 doMoveTerm :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli ()

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

@@ -1,6 +1,6 @@
 module Unison.Codebase.Editor.HandleInput.MoveType (doMoveType, moveTypeSteps) where
 
-import Control.Lens (_2)
+import Control.Lens (_1, _2)
 import Data.Set qualified as Set
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
@@ -9,14 +9,14 @@ import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch (Branch0)
 import Unison.Codebase.BranchUtil qualified as BranchUtil
 import Unison.Codebase.Editor.Output qualified as Output
-import Unison.Codebase.Path (Path, Path')
+import Unison.Codebase.Path (Path')
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.ProjectPath qualified as PP
 import Unison.HashQualified' qualified as HQ'
 import Unison.NameSegment (NameSegment)
 import Unison.Prelude
 
-moveTypeSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path, Branch0 m -> Branch0 m)]
+moveTypeSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path.Absolute, Branch0 m -> Branch0 m)]
 moveTypeSteps src' dest' = do
   src <- Cli.resolveSplit' src'
   srcTypes <- Cli.getTypesAt src
@@ -30,11 +30,11 @@ moveTypeSteps src' dest' = do
       destTypes <- Cli.getTypesAt (Path.convert dest)
       when (not (Set.null destTypes)) do
         Cli.returnEarly (Output.TypeAlreadyExists dest' destTypes)
-      let p = over _1 (view PP.path_) src
+      let p = over _1 (view PP.absPath_) src
       pure
         [ -- Mitchell: throwing away any hash-qualification here seems wrong!
           BranchUtil.makeDeleteTypeName (over _2 HQ'.toName p) srcType,
-          BranchUtil.makeAddTypeName (over _1 (view PP.path_) dest) srcType
+          BranchUtil.makeAddTypeName (over _1 (view PP.absPath_) dest) srcType
         ]
 
 doMoveType :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli ()

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

@@ -14,7 +14,7 @@ import U.Codebase.Reference qualified as Reference
 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.NamesUtils qualified as Cli
 import Unison.Cli.TypeCheck qualified as Cli (computeTypecheckingEnvironment)
 import Unison.Codebase (Codebase)
 import Unison.Codebase qualified as Codebase
@@ -241,7 +241,7 @@ propagate patch b = case validatePatch patch of
     pure noEdits
   Just (initialTermEdits, initialTypeEdits) -> do
     -- TODO: this can be removed once patches have term replacement of type `Referent -> Referent`
-    rootNames <- Branch.toNames <$> Cli.getProjectRoot0
+    rootNames <- Cli.projectRootNames
 
     let -- TODO: these are just used for tracing, could be deleted if we don't care
         -- about printing meaningful names for definitions during propagation, or if