module Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch, moveBranchFunc) where

import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
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

-- | Note: Currently only allows moving within the same project-branch, should be easy to change in the future if
-- needed.
moveBranchFunc :: Bool -> Path.Path' -> Path.Path' -> Cli (Maybe (Path.Absolute, Branch IO -> Branch IO))
moveBranchFunc :: Bool
-> Path' -> Path' -> Cli (Maybe (Absolute, Branch IO -> Branch IO))
moveBranchFunc Bool
hasConfirmed Path'
src' Path'
dest' = do
  -- We currently only support moving within the same project branch.
  srcPP :: ProjectPath
srcPP@(PP.ProjectPath Project
_proj ProjectBranch
_projBranch Absolute
srcAbs) <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
src'
  PP.ProjectPath Project
_ ProjectBranch
_ Absolute
destAbs <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
dest'
  Bool
destBranchExists <- Path' -> Cli Bool
Cli.branchExistsAtPath' Path'
dest'
  let isRootMove :: Bool
isRootMove = (Absolute -> Bool
Path.isRoot Absolute
srcAbs Bool -> Bool -> Bool
|| Absolute -> Bool
Path.isRoot Absolute
destAbs)
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isRootMove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasConfirmed) do
    Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly Output
MoveRootBranchConfirmation
  ProjectPath -> Cli (Maybe (Branch IO))
Cli.getMaybeBranchFromProjectPath ProjectPath
srcPP Cli (Maybe (Branch IO))
-> (Maybe (Branch IO)
    -> Cli (Maybe (Absolute, Branch IO -> Branch IO)))
-> Cli (Maybe (Absolute, Branch IO -> Branch IO))
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Branch IO -> Cli (Absolute, Branch IO -> Branch IO))
-> Maybe (Branch IO)
-> Cli (Maybe (Absolute, Branch IO -> Branch IO))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse \Branch IO
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.
    let (Path
changeRootPath, Path
srcLoc, Path
destLoc) = Path -> Path -> (Path, Path, Path)
Path.longestPathPrefix (Absolute -> Path
Path.unabsolute Absolute
srcAbs) (Absolute -> Path
Path.unabsolute Absolute
destAbs)
    let doMove :: Branch IO -> Branch IO
doMove Branch IO
changeRoot =
          Branch IO
changeRoot
            Branch IO -> (Branch IO -> Branch IO) -> Branch IO
forall a b. a -> (a -> b) -> b
& Path -> (Branch IO -> Branch IO) -> Branch IO -> Branch IO
forall (m :: * -> *).
Applicative m =>
Path -> (Branch m -> Branch m) -> Branch m -> Branch m
Branch.modifyAt Path
srcLoc (Branch IO -> Branch IO -> Branch IO
forall a b. a -> b -> a
const Branch IO
forall (m :: * -> *). Branch m
Branch.empty)
            Branch IO -> (Branch IO -> Branch IO) -> Branch IO
forall a b. a -> (a -> b) -> b
& Path -> (Branch IO -> Branch IO) -> Branch IO -> Branch IO
forall (m :: * -> *).
Applicative m =>
Path -> (Branch m -> Branch m) -> Branch m -> Branch m
Branch.modifyAt Path
destLoc (Branch IO -> Branch IO -> Branch IO
forall a b. a -> b -> a
const Branch IO
srcBranch)
    if (Bool
destBranchExists Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isRootMove)
      then Output -> Cli ()
Cli.respond (Path' -> Output
MovedOverExistingBranch Path'
dest')
      else () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    pure (Path -> Absolute
Path.Absolute Path
changeRootPath, Branch IO -> Branch IO
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 :: Text -> Bool -> Path' -> Path' -> Cli ()
doMoveBranch Text
actionDescription Bool
hasConfirmed Path'
src' Path'
dest' = do
  Bool
-> Path' -> Path' -> Cli (Maybe (Absolute, Branch IO -> Branch IO))
moveBranchFunc Bool
hasConfirmed Path'
src' Path'
dest' Cli (Maybe (Absolute, Branch IO -> Branch IO))
-> (Maybe (Absolute, Branch IO -> Branch IO) -> Cli ()) -> Cli ()
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Absolute, Branch IO -> Branch IO)
Nothing -> Output -> Cli ()
Cli.respond (Path' -> Output
BranchNotFound Path'
src')
    Just (Absolute
absPath, Branch IO -> Branch IO
func) -> do
      ProjectPath
pp <- Path' -> Cli ProjectPath
Cli.resolvePath' (Absolute -> Path'
Path.AbsolutePath' Absolute
absPath)
      Bool
_ <- Text -> ProjectPath -> (Branch IO -> Branch IO) -> Cli Bool
Cli.updateAt Text
actionDescription ProjectPath
pp Branch IO -> Branch IO
func
      Output -> Cli ()
Cli.respond Output
Success