-- | @delete.branch@ input handler
module Unison.Codebase.Editor.HandleInput.DeleteBranch
  ( handleDeleteBranch,
    handleDeleteBranch2,
    doDeleteProjectBranch,
  )
where

import Control.Lens
import Data.List qualified as List
import U.Codebase.Sqlite.DbId
import U.Codebase.Sqlite.Project (Project (..))
import U.Codebase.Sqlite.Project qualified as Sqlite
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
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 qualified as Codebase
import Unison.Codebase.ProjectPath (ProjectPathG (..))
import Unison.Codebase.SqliteCodebase.Operations qualified as Ops
import Unison.Core.Project (ProjectBranchName (..), ProjectName (..))
import Unison.Prelude
import Unison.Project (ProjectAndBranch (..), defaultBranchName)
import Unison.Sqlite qualified as Sqlite

-- | Delete a project branch.
--
-- Currently, deleting a branch means deleting its `project_branch` row, then deleting its contents from the namespace.
-- 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 :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
handleDeleteBranch ProjectAndBranch (Maybe ProjectName) ProjectBranchName
namesToDelete = do
  ProjectPath
current <- Cli ProjectPath
Cli.getCurrentProjectPath
  ProjectAndBranch Project ProjectBranch
toDelete <- Project
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
ProjectUtils.resolveProjectBranchInProject ProjectPath
current.project (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
namesToDelete ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
    -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName))
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
forall a b. a -> (a -> b) -> b
& ASetter
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
  (ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName))
  ProjectBranchName
  (Maybe ProjectBranchName)
#branch ASetter
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
  (ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName))
  ProjectBranchName
  (Maybe ProjectBranchName)
-> (ProjectBranchName -> Maybe ProjectBranchName)
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ProjectBranchName -> Maybe ProjectBranchName
forall a. a -> Maybe a
Just)
  ProjectAndBranch Project ProjectBranch -> Cli ()
handleDeleteBranch2 ProjectAndBranch Project ProjectBranch
toDelete

-- | Like 'handleDeleteBranch2', but for when the branch name to delete is already resolved to a branch.
handleDeleteBranch2 :: ProjectAndBranch Project ProjectBranch -> Cli ()
handleDeleteBranch2 :: ProjectAndBranch Project ProjectBranch -> Cli ()
handleDeleteBranch2 ProjectAndBranch Project ProjectBranch
toDelete = do
  ProjectPath
current <- Cli ProjectPath
Cli.getCurrentProjectPath

  -- 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. Any other branch in the codebase
  --   4. Create a new branch in the current project
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProjectAndBranch Project ProjectBranch
toDelete.branch.branchId ProjectBranchId -> ProjectBranchId -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectPath
current.branch.branchId) do
    ProjectAndBranch ProjectId ProjectBranchId
nextLocation <-
      Transaction (ProjectAndBranch ProjectId ProjectBranchId)
-> Cli (ProjectAndBranch ProjectId ProjectBranchId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
        Maybe (ProjectAndBranch ProjectId ProjectBranchId)
maybeNextLocation <-
          MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
-> Transaction (Maybe (ProjectAndBranch ProjectId ProjectBranchId))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
 -> Transaction
      (Maybe (ProjectAndBranch ProjectId ProjectBranchId)))
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
-> Transaction (Maybe (ProjectAndBranch ProjectId ProjectBranchId))
forall a b. (a -> b) -> a -> b
$
            [MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)]
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
              [ ProjectId
-> Maybe ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
parentBranch ProjectAndBranch Project ProjectBranch
toDelete.branch.projectId ProjectAndBranch Project ProjectBranch
toDelete.branch.parentBranchId,
                ProjectId
-> ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
findMainBranchInProjectExcept ProjectPath
current.project.projectId ProjectAndBranch Project ProjectBranch
toDelete.branch.branchId,
                -- Any branch in the codebase except the one we're deleting
                ProjectId
-> ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
findAnyBranchInProjectExcept ProjectAndBranch Project ProjectBranch
toDelete.branch.projectId ProjectAndBranch Project ProjectBranch
toDelete.branch.branchId,
                ProjectId
-> ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
findAnyBranchInCodebaseExcept ProjectAndBranch Project ProjectBranch
toDelete.branch.projectId ProjectAndBranch Project ProjectBranch
toDelete.branch.branchId
              ]
        case Maybe (ProjectAndBranch ProjectId ProjectBranchId)
maybeNextLocation of
          Just ProjectAndBranch ProjectId ProjectBranchId
nextLocation -> ProjectAndBranch ProjectId ProjectBranchId
-> Transaction (ProjectAndBranch ProjectId ProjectBranchId)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectAndBranch ProjectId ProjectBranchId
nextLocation
          Maybe (ProjectAndBranch ProjectId ProjectBranchId)
Nothing -> ProjectName
-> ProjectBranchName
-> Transaction (ProjectAndBranch ProjectId ProjectBranchId)
createNewBranchInProjectExcept ProjectAndBranch Project ProjectBranch
toDelete.project.name ProjectAndBranch Project ProjectBranch
toDelete.branch.name

    ProjectAndBranch ProjectId ProjectBranchId -> Cli ()
Cli.switchProject ProjectAndBranch ProjectId ProjectBranchId
nextLocation

  HasCallStack => ProjectAndBranch Project ProjectBranch -> Cli ()
ProjectAndBranch Project ProjectBranch -> Cli ()
doDeleteProjectBranch ProjectAndBranch Project ProjectBranch
toDelete
  where
    parentBranch :: ProjectId -> Maybe ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId)
    parentBranch :: ProjectId
-> Maybe ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
parentBranch ProjectId
projectId Maybe ProjectBranchId
mayParentBranchId = do
      ProjectBranchId
parentBranchId <- Maybe ProjectBranchId -> MaybeT Transaction ProjectBranchId
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe Maybe ProjectBranchId
mayParentBranchId
      ProjectAndBranch ProjectId ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectId
projectId ProjectBranchId
parentBranchId)

    findMainBranchInProjectExcept :: ProjectId -> ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId)
    findMainBranchInProjectExcept :: ProjectId
-> ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
findMainBranchInProjectExcept ProjectId
projectId ProjectBranchId
exceptBranchId = do
      ProjectBranch
branch <- Transaction (Maybe ProjectBranch)
-> MaybeT Transaction ProjectBranch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe ProjectBranch)
 -> MaybeT Transaction ProjectBranch)
-> Transaction (Maybe ProjectBranch)
-> MaybeT Transaction ProjectBranch
forall a b. (a -> b) -> a -> b
$ ProjectId -> ProjectBranchName -> Transaction (Maybe ProjectBranch)
Queries.loadProjectBranchByName ProjectId
projectId ProjectBranchName
defaultBranchName
      Bool -> MaybeT Transaction ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ProjectBranch
branch.branchId ProjectBranchId -> ProjectBranchId -> Bool
forall a. Eq a => a -> a -> Bool
/= ProjectBranchId
exceptBranchId)
      ProjectAndBranch ProjectId ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectId
projectId ProjectBranch
branch.branchId)

    findAnyBranchInProjectExcept :: ProjectId -> ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId)
    findAnyBranchInProjectExcept :: ProjectId
-> ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
findAnyBranchInProjectExcept ProjectId
projectId ProjectBranchId
exceptBranchId = do
      (ProjectBranchId
someBranchId, ProjectBranchName
_) <- Transaction (Maybe (ProjectBranchId, ProjectBranchName))
-> MaybeT Transaction (ProjectBranchId, ProjectBranchName)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe (ProjectBranchId, ProjectBranchName))
 -> MaybeT Transaction (ProjectBranchId, ProjectBranchName))
-> (Transaction [(ProjectBranchId, ProjectBranchName)]
    -> Transaction (Maybe (ProjectBranchId, ProjectBranchName)))
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> MaybeT Transaction (ProjectBranchId, ProjectBranchName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(ProjectBranchId, ProjectBranchName)]
 -> Maybe (ProjectBranchId, ProjectBranchName))
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> Transaction (Maybe (ProjectBranchId, ProjectBranchName))
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ProjectBranchId, ProjectBranchName) -> Bool)
-> [(ProjectBranchId, ProjectBranchName)]
-> Maybe (ProjectBranchId, ProjectBranchName)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\(ProjectBranchId
branchId, ProjectBranchName
_) -> ProjectBranchId
branchId ProjectBranchId -> ProjectBranchId -> Bool
forall a. Eq a => a -> a -> Bool
/= ProjectBranchId
exceptBranchId)) (Transaction [(ProjectBranchId, ProjectBranchName)]
 -> MaybeT Transaction (ProjectBranchId, ProjectBranchName))
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> MaybeT Transaction (ProjectBranchId, ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Queries.loadAllProjectBranchesBeginningWith ProjectId
projectId Maybe Text
forall a. Maybe a
Nothing
      ProjectAndBranch ProjectId ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectId
projectId ProjectBranchId
someBranchId)

    findAnyBranchInCodebaseExcept :: ProjectId -> ProjectBranchId -> MaybeT Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId)
    findAnyBranchInCodebaseExcept :: ProjectId
-> ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
findAnyBranchInCodebaseExcept ProjectId
exceptProjectId ProjectBranchId
exceptBranchId = do
      (ProjectAndBranch ProjectName ProjectBranchName
_, ProjectAndBranch ProjectId ProjectBranchId
pbIds) <- Transaction
  (Maybe
     (ProjectAndBranch ProjectName ProjectBranchName,
      ProjectAndBranch ProjectId ProjectBranchId))
-> MaybeT
     Transaction
     (ProjectAndBranch ProjectName ProjectBranchName,
      ProjectAndBranch ProjectId ProjectBranchId)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction
   (Maybe
      (ProjectAndBranch ProjectName ProjectBranchName,
       ProjectAndBranch ProjectId ProjectBranchId))
 -> MaybeT
      Transaction
      (ProjectAndBranch ProjectName ProjectBranchName,
       ProjectAndBranch ProjectId ProjectBranchId))
-> (Transaction
      [(ProjectAndBranch ProjectName ProjectBranchName,
        ProjectAndBranch ProjectId ProjectBranchId)]
    -> Transaction
         (Maybe
            (ProjectAndBranch ProjectName ProjectBranchName,
             ProjectAndBranch ProjectId ProjectBranchId)))
-> Transaction
     [(ProjectAndBranch ProjectName ProjectBranchName,
       ProjectAndBranch ProjectId ProjectBranchId)]
-> MaybeT
     Transaction
     (ProjectAndBranch ProjectName ProjectBranchName,
      ProjectAndBranch ProjectId ProjectBranchId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(ProjectAndBranch ProjectName ProjectBranchName,
   ProjectAndBranch ProjectId ProjectBranchId)]
 -> Maybe
      (ProjectAndBranch ProjectName ProjectBranchName,
       ProjectAndBranch ProjectId ProjectBranchId))
-> Transaction
     [(ProjectAndBranch ProjectName ProjectBranchName,
       ProjectAndBranch ProjectId ProjectBranchId)]
-> Transaction
     (Maybe
        (ProjectAndBranch ProjectName ProjectBranchName,
         ProjectAndBranch ProjectId ProjectBranchId))
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ProjectAndBranch ProjectName ProjectBranchName,
  ProjectAndBranch ProjectId ProjectBranchId)
 -> Bool)
-> [(ProjectAndBranch ProjectName ProjectBranchName,
     ProjectAndBranch ProjectId ProjectBranchId)]
-> Maybe
     (ProjectAndBranch ProjectName ProjectBranchName,
      ProjectAndBranch ProjectId ProjectBranchId)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\(ProjectAndBranch ProjectName ProjectBranchName
_, ProjectAndBranch ProjectId ProjectBranchId
ids) -> ProjectAndBranch ProjectId ProjectBranchId
ids ProjectAndBranch ProjectId ProjectBranchId
-> ProjectAndBranch ProjectId ProjectBranchId -> Bool
forall a. Eq a => a -> a -> Bool
/= ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectId
exceptProjectId ProjectBranchId
exceptBranchId)) (Transaction
   [(ProjectAndBranch ProjectName ProjectBranchName,
     ProjectAndBranch ProjectId ProjectBranchId)]
 -> MaybeT
      Transaction
      (ProjectAndBranch ProjectName ProjectBranchName,
       ProjectAndBranch ProjectId ProjectBranchId))
-> Transaction
     [(ProjectAndBranch ProjectName ProjectBranchName,
       ProjectAndBranch ProjectId ProjectBranchId)]
-> MaybeT
     Transaction
     (ProjectAndBranch ProjectName ProjectBranchName,
      ProjectAndBranch ProjectId ProjectBranchId)
forall a b. (a -> b) -> a -> b
$ Transaction
  [(ProjectAndBranch ProjectName ProjectBranchName,
    ProjectAndBranch ProjectId ProjectBranchId)]
Queries.loadAllProjectBranchNamePairs
      ProjectAndBranch ProjectId ProjectBranchId
-> MaybeT Transaction (ProjectAndBranch ProjectId ProjectBranchId)
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectAndBranch ProjectId ProjectBranchId
pbIds

    createNewBranchInProjectExcept :: ProjectName -> ProjectBranchName -> Sqlite.Transaction (ProjectAndBranch ProjectId ProjectBranchId)
    createNewBranchInProjectExcept :: ProjectName
-> ProjectBranchName
-> Transaction (ProjectAndBranch ProjectId ProjectBranchId)
createNewBranchInProjectExcept ProjectName
projectName = \case
      UnsafeProjectBranchName Text
"main" -> do
        (CausalHash
_, CausalHashId
emptyCausalHashId) <- Transaction (CausalHash, CausalHashId)
Codebase.emptyCausalHash
        ProjectName
-> ProjectBranchName
-> CausalHashId
-> Transaction (Project, ProjectBranchRow)
Ops.insertProjectAndBranch ProjectName
projectName (Text -> ProjectBranchName
UnsafeProjectBranchName Text
"main2") CausalHashId
emptyCausalHashId
          Transaction (Project, ProjectBranchRow)
-> ((Project, ProjectBranchRow)
    -> ProjectAndBranch ProjectId ProjectBranchId)
-> Transaction (ProjectAndBranch ProjectId ProjectBranchId)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Project
proj, ProjectBranchRow
branch) -> ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
proj.projectId ProjectBranchRow
branch.branchId
      ProjectBranchName
_ -> do
        (CausalHash
_, CausalHashId
emptyCausalHashId) <- Transaction (CausalHash, CausalHashId)
Codebase.emptyCausalHash
        ProjectName
-> ProjectBranchName
-> CausalHashId
-> Transaction (Project, ProjectBranchRow)
Ops.insertProjectAndBranch ProjectName
projectName (Text -> ProjectBranchName
UnsafeProjectBranchName Text
"main") CausalHashId
emptyCausalHashId
          Transaction (Project, ProjectBranchRow)
-> ((Project, ProjectBranchRow)
    -> ProjectAndBranch ProjectId ProjectBranchId)
-> Transaction (ProjectAndBranch ProjectId ProjectBranchId)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Project
proj, ProjectBranchRow
branch) -> ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
proj.projectId ProjectBranchRow
branch.branchId

-- | Delete a project branch and record an entry in the reflog.
doDeleteProjectBranch :: (HasCallStack) => ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> Cli ()
doDeleteProjectBranch :: HasCallStack => ProjectAndBranch Project ProjectBranch -> Cli ()
doDeleteProjectBranch ProjectAndBranch Project ProjectBranch
projectAndBranch = do
  Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction do
    HasCallStack => ProjectId -> ProjectBranchId -> Transaction ()
ProjectId -> ProjectBranchId -> Transaction ()
Queries.deleteProjectBranch ProjectAndBranch Project ProjectBranch
projectAndBranch.project.projectId ProjectAndBranch Project ProjectBranch
projectAndBranch.branch.branchId