-- | @branch.squash@ input handler
module Unison.Codebase.Editor.HandleInput.BranchSquash (handleBranchSquash) where

import Data.These (These (..))
import U.Codebase.Branch qualified as V2Branch
import U.Codebase.Causal (Causal (..))
import U.Codebase.Causal.Squash qualified as UCausal
import U.Codebase.Sqlite.Project (Project)
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch)
import U.Codebase.Sqlite.V2.HashHandle qualified as HH
import Unison.Cli.Monad
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.ProjectUtils qualified as Project
import Unison.Cli.ProjectUtils qualified as ProjectUtils
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Editor.HandleInput.Branch qualified as Branch
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Prelude
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
import Unison.Sqlite qualified as Sqlite

data SquashDestination
  = -- Update an existing branch with the squash result
    ExistingBranch (ProjectAndBranch Project ProjectBranch)
  | -- Create a new branch from the squashed branch
    NewBranch ProjectUtils.Project ProjectBranchName

handleBranchSquash :: (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) -> Cli ()
handleBranchSquash :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
handleBranchSquash ProjectAndBranch (Maybe ProjectName) ProjectBranchName
branchToSquash ProjectAndBranch (Maybe ProjectName) ProjectBranchName
mayDestBranch = do
  currentProj <- Cli Project
Cli.getCurrentProject
  let sourceNames = case ProjectAndBranch (Maybe ProjectName) ProjectBranchName
branchToSquash of
        ProjectAndBranch (Just ProjectName
project) ProjectBranchName
branch -> ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
project ProjectBranchName
branch
        ProjectAndBranch Maybe ProjectName
Nothing ProjectBranchName
branch -> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectBranchName
branch
  sourcePAB <- ProjectUtils.expectProjectAndBranchByTheseNames sourceNames
  causalBranchToSquash <- Cli.runTransaction $ Codebase.expectProjectBranchRootCausal sourcePAB.branch
  let destNames = case ProjectAndBranch (Maybe ProjectName) ProjectBranchName
mayDestBranch of
        ProjectAndBranch (Just ProjectName
project) ProjectBranchName
branch -> ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
project ProjectBranchName
branch
        ProjectAndBranch Maybe ProjectName
Nothing ProjectBranchName
branch -> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectBranchName
branch
  destProj <-
    fromMaybe currentProj <$> runMaybeT do
      projName <- hoistMaybe branchToSquash.project
      MaybeT $ Project.getProjectByName projName
  mayDestPAB <- ProjectUtils.getProjectAndBranchByTheseNames destNames
  let squashDest = case Maybe (ProjectAndBranch Project ProjectBranch)
mayDestPAB of
        Just ProjectAndBranch Project ProjectBranch
destPAB -> ProjectAndBranch Project ProjectBranch -> SquashDestination
ExistingBranch ProjectAndBranch Project ProjectBranch
destPAB
        Maybe (ProjectAndBranch Project ProjectBranch)
Nothing -> Project -> ProjectBranchName -> SquashDestination
NewBranch Project
destProj ProjectAndBranch (Maybe ProjectName) ProjectBranchName
mayDestBranch.branch

  squashResult <- Cli.runTransaction $ squashCausal causalBranchToSquash
  let description = Text
"Squashed from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CausalHash -> Text
forall a. Show a => a -> Text
tShow CausalBranch Transaction
causalBranchToSquash.causalHash
  case squashDest of
    NewBranch Project
project ProjectBranchName
newBranchName -> do
      (newPAB, _) <- Text
-> CreateFrom
-> Project
-> Transaction ProjectBranchName
-> Cli
     (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
Branch.createBranch Text
description (CausalHash -> CreateFrom
Branch.CreateFrom'CausalHash CausalBranch Transaction
squashResult.causalHash) Project
project (ProjectBranchName -> Transaction ProjectBranchName
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectBranchName
newBranchName)
      destBranch <- Cli.runTransaction $ ProjectUtils.expectProjectAndBranchByIds newPAB
      Cli.respond $ Output.BranchSquashSuccess sourcePAB destBranch
      pure ()
    ExistingBranch ProjectAndBranch Project ProjectBranch
destBranch -> do
      HasCallStack => ProjectBranch -> Text -> CausalHash -> Cli ()
ProjectBranch -> Text -> CausalHash -> Cli ()
Cli.setProjectBranchRootToCausalHash ProjectAndBranch Project ProjectBranch
destBranch.branch Text
description CausalBranch Transaction
squashResult.causalHash
      Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ ProjectAndBranch Project ProjectBranch
-> ProjectAndBranch Project ProjectBranch -> Output
Output.BranchSquashSuccess ProjectAndBranch Project ProjectBranch
sourcePAB ProjectAndBranch Project ProjectBranch
destBranch
  pure ()

squashCausal :: V2Branch.CausalBranch Sqlite.Transaction -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
squashCausal :: CausalBranch Transaction -> Transaction (CausalBranch Transaction)
squashCausal CausalBranch Transaction
causalBranch = do
  HashHandle
-> CausalBranch Transaction
-> Transaction (CausalBranch Transaction)
UCausal.squashCausal HashHandle
HH.v2HashHandle CausalBranch Transaction
causalBranch