mit-3qvpPyAi6mH-12: src/Mit/Command/Merge.hs

module Mit.Command.Merge
  ( mitMerge,
  )
where

import Mit.Command.Commit (abortIfCouldFastForwardToUpstream)
import Mit.Git
  ( git,
    gitApplyStash,
    gitCurrentBranch,
    gitFetch,
    gitMaybeHead,
    gitMergeInProgress,
    gitRemoteBranchHead,
  )
import Mit.Logger (Logger, log)
import Mit.Merge (MergeResult (..), mergeResultConflicts, performMerge)
import Mit.Output (Output)
import Mit.Output qualified as Output
import Mit.Prelude
import Mit.ProcessInfo (ProcessInfo (..))
import Mit.Push
  ( DidntPushReason (NothingToPush, PushWouldBeRejected, PushWouldntReachRemote, TriedToPush),
    PushResult (DidntPush, Pushed),
    performPush,
    pushResultPushed,
  )
import Mit.Seq1 qualified as Seq1
import Mit.Snapshot (performSnapshot, snapshotStash, undoToSnapshot)
import Mit.State (MitState (..), writeMitState)
import System.Exit (ExitCode (..))
import UnconditionalJump (Label, goto)

mitMerge :: Label ExitCode -> Logger Output -> Logger ProcessInfo -> IO () -> Text -> Text -> IO ()
mitMerge exit output pinfo sync gitdir source = do
  whenM (gitMergeInProgress gitdir) do
    log output Output.MergeInProgress
    goto exit (ExitFailure 1)

  branch <-
    gitCurrentBranch pinfo & onNothingM do
      log output Output.NotOnBranch
      goto exit (ExitFailure 1)

  let upstream = "origin/" <> branch

  -- Special case: if on branch "foo", treat `mit merge foo` and `mit merge origin/foo` as `mit sync`
  case source == branch || source == upstream of
    True -> sync
    False -> mitMerge_ exit output pinfo gitdir source branch

mitMerge_ :: Label ExitCode -> Logger Output -> Logger ProcessInfo -> Text -> Text -> Text -> IO ()
mitMerge_ exit output pinfo gitdir source branch = do
  fetched <- gitFetch pinfo "origin"
  maybeHead0 <- gitMaybeHead pinfo
  maybeUpstreamHead <- gitRemoteBranchHead pinfo "origin" branch
  snapshot <- performSnapshot pinfo

  -- When given 'mit merge foo', prefer running 'git merge origin/foo' over 'git merge foo'
  sourceCommit <-
    gitRemoteBranchHead pinfo "origin" source & onNothingM do
      git pinfo ["rev-parse", "refs/heads/" <> source] & onLeftM \_ -> do
        log output Output.NoSuchBranch
        goto exit (ExitFailure 1)

  abortIfCouldFastForwardToUpstream exit output pinfo maybeHead0 maybeUpstreamHead fetched

  whenJust (snapshotStash snapshot) \_stash ->
    git @() pinfo ["reset", "--hard", "--quiet", "HEAD"]

  mergeResult <- performMerge pinfo gitdir sourceCommit ("⅄ " <> source <> " → " <> branch)

  log output case mergeResult of
    NothingToMerge -> Output.NothingToMerge source branch
    TriedToMerge commits conflicts -> Output.MergeFailed commits conflicts
    Merged commits -> Output.MergeSucceeded (Just commits)

  head1 <- git pinfo ["rev-parse", "HEAD"] -- FIXME oops this can be Nothing
  pushResult <- performPush pinfo branch (Just head1) maybeUpstreamHead fetched

  case pushResult of
    DidntPush NothingToPush -> pure ()
    DidntPush (PushWouldBeRejected localCommits numRemoteCommits) ->
      log output (Output.PushWouldBeRejected localCommits numRemoteCommits)
    DidntPush (PushWouldntReachRemote commits) -> log output (Output.PushWouldntReachRemote commits)
    DidntPush (TriedToPush commits) -> log output (Output.PushFailed commits)
    Pushed commits -> log output (Output.PushSucceeded commits)

  let undo1 =
        if pushResultPushed pushResult || isNothing (mergeResultConflicts mergeResult)
          then Nothing
          else undoToSnapshot snapshot

  writeMitState
    gitdir
    branch
    MitState
      { head = head1,
        merging =
          case mergeResultConflicts mergeResult of
            Nothing -> Nothing
            Just _conflicts -> Just source,
        undo = undo1
      }

  when (isNothing (mergeResultConflicts mergeResult)) do
    whenJust (snapshotStash snapshot) \stash -> do
      conflicts0 <- gitApplyStash pinfo stash
      whenJust (Seq1.fromList conflicts0) \conflicts1 -> log output (Output.UnstashFailed conflicts1)

  when (isJust undo1) (log output Output.CanUndo)