mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-17 13:27:30 +03:00
Revive move-branch confirmations
This commit is contained in:
parent
09ecc74ce0
commit
15431602ac
@ -328,8 +328,9 @@ loop e = do
|
||||
(ppe, diff) <- diffHelper beforeBranch0 afterBranch0
|
||||
Cli.respondNumbered (ShowDiffNamespace beforeLoc afterLoc ppe diff)
|
||||
MoveBranchI src' dest' -> do
|
||||
hasConfirmed <- confirmedCommand input
|
||||
description <- inputDescription input
|
||||
doMoveBranch description src' dest'
|
||||
doMoveBranch description hasConfirmed src' dest'
|
||||
SwitchBranchI path' -> do
|
||||
path <- Cli.resolvePath' path'
|
||||
branchExists <- Cli.branchExistsAtPath' path'
|
||||
@ -566,8 +567,9 @@ loop e = do
|
||||
MoveTermI src' dest' -> doMoveTerm src' dest' =<< inputDescription input
|
||||
MoveTypeI src' dest' -> doMoveType src' dest' =<< inputDescription input
|
||||
MoveAllI src' dest' -> do
|
||||
hasConfirmed <- confirmedCommand input
|
||||
desc <- inputDescription input
|
||||
handleMoveAll src' dest' desc
|
||||
handleMoveAll hasConfirmed src' dest' desc
|
||||
DeleteI dtarget -> do
|
||||
pp <- Cli.getCurrentProjectPath
|
||||
let getTerms (absPath, seg) = Cli.getTermsAt (set PP.absPath_ absPath pp, seg)
|
||||
|
@ -11,9 +11,9 @@ import Unison.Codebase.Path qualified as Path
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.Prelude
|
||||
|
||||
handleMoveAll :: Path.Path' -> Path.Path' -> Text -> Cli ()
|
||||
handleMoveAll src' dest' description = do
|
||||
moveBranchFunc <- moveBranchFunc src' dest'
|
||||
handleMoveAll :: Bool -> Path.Path' -> Path.Path' -> Text -> Cli ()
|
||||
handleMoveAll hasConfirmed src' dest' description = do
|
||||
moveBranchFunc <- moveBranchFunc hasConfirmed src' dest'
|
||||
moveTermTypeSteps <- case (,) <$> Path.toSplit' src' <*> Path.toSplit' dest' of
|
||||
Nothing -> pure []
|
||||
Just (fmap HQ'.NameOnly -> src, dest) -> do
|
||||
|
@ -12,12 +12,15 @@ import Unison.Prelude
|
||||
|
||||
-- | Note: Currently only allows moving within the same project-branch, should be easy to change in the future if
|
||||
-- needed.
|
||||
moveBranchFunc :: Path.Path' -> Path.Path' -> Cli (Maybe (Path.Absolute, Branch IO -> Branch IO))
|
||||
moveBranchFunc src' dest' = do
|
||||
moveBranchFunc :: Bool -> Path.Path' -> Path.Path' -> Cli (Maybe (Path.Absolute, Branch IO -> Branch IO))
|
||||
moveBranchFunc hasConfirmed 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.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
|
||||
@ -27,16 +30,16 @@ moveBranchFunc src' dest' = do
|
||||
changeRoot
|
||||
& Branch.modifyAt srcLoc (const Branch.empty)
|
||||
& Branch.modifyAt destLoc (const srcBranch)
|
||||
if destBranchExists
|
||||
if (destBranchExists && not isRootMove)
|
||||
then Cli.respond (MovedOverExistingBranch dest')
|
||||
else pure ()
|
||||
pure (Path.Absolute changeRootPath, doMove)
|
||||
|
||||
-- | Moves a branch and its history from one location to another, and saves the new root
|
||||
-- branch.
|
||||
doMoveBranch :: Text -> Path.Path' -> Path.Path' -> Cli ()
|
||||
doMoveBranch actionDescription src' dest' = do
|
||||
moveBranchFunc src' dest' >>= \case
|
||||
doMoveBranch :: Text -> Bool -> Path.Path' -> Path.Path' -> Cli ()
|
||||
doMoveBranch actionDescription hasConfirmed src' dest' = do
|
||||
moveBranchFunc hasConfirmed src' dest' >>= \case
|
||||
Nothing -> Cli.respond (BranchNotFound src')
|
||||
Just (absPath, func) -> do
|
||||
pp <- Cli.resolvePath' (Path.AbsolutePath' absPath)
|
||||
|
Loading…
Reference in New Issue
Block a user