-- | @branch@ input handler
module Unison.Codebase.Editor.HandleInput.Branch
  ( CreateFrom (..),
    CreateFromMergeSource (..),
    handleBranch,
    createBranch,
  )
where

import Control.Monad.Reader
import Data.UUID.V4 qualified as UUID
import Network.URI (URI)
import U.Codebase.HashTags (CausalHash)
import U.Codebase.Sqlite.DbId
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 Q
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.Cli.Share.Projects.Types (RemoteProjectBranch (..))
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Editor.Input qualified as Input
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Name (Name)
import Unison.Prelude
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectBranchNameKind (..), ProjectName, classifyProjectBranchName)
import Unison.Sqlite qualified as Sqlite

data CreateFrom
  = CreateFrom'ParentBranch Sqlite.ProjectBranch
  | CreateFrom'Namespace (Branch IO)
  | CreateFrom'CausalHash CausalHash
  | -- A merge failed (from local branch, remote branch, or remote loose code), and we're making a branch for the user
    -- to resolve the merge on
    CreateFrom'MergeParents
      (CreateFromMergeSource, CausalHash, Map Name Text {- unique type name to guid -}) -- source
      (Sqlite.ProjectBranch, CausalHash, Map Name Text {- unique type name to guid -}) -- target
      (Branch Sqlite.Transaction) -- merge branch
  | -- An update failed, and we're making a branch for the user to complete the update on
    CreateFrom'Update
      (Sqlite.ProjectBranch, CausalHash, Map Name Text {- unique type name to guid -})
      (Branch IO) -- update branch contents
  | CreateFrom'Upgrade
      (Sqlite.ProjectBranch, CausalHash, Map Name Text {- unique type name to guid -})
      (Branch IO) -- upgrade branch contents
  | CreateFrom'Nothingness

data CreateFromMergeSource
  = CreateFromMergeSource'Local Sqlite.ProjectBranch
  | CreateFromMergeSource'Remote RemoteProjectBranch URI
  | CreateFromMergeSource'LooseCode

-- | Create a new project branch from an existing project branch or namespace.
handleBranch :: Input.BranchSourceI -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
handleBranch :: BranchSourceI -> UnresolvedProjectBranch -> Cli ()
handleBranch BranchSourceI
sourceI projectAndBranchNames :: UnresolvedProjectBranch
projectAndBranchNames@(ProjectAndBranch Maybe ProjectName
mayProjectName ProjectBranchName
newBranchName) = do
  -- You can only create release branches with `branch.clone`
  --
  -- We do allow creating draft release branches with `branch`, but you'll get different output if you use
  -- `release.draft`
  case ProjectBranchName -> ProjectBranchNameKind
classifyProjectBranchName ProjectBranchName
newBranchName of
    ProjectBranchNameKind'Contributor Text
_user ProjectBranchName
_name -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ProjectBranchNameKind'DraftRelease Semver
_ver -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ProjectBranchNameKind'Release Semver
ver ->
      Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (ProjectBranchName -> Semver -> Output
Output.CannotCreateReleaseBranchWithBranchCommand ProjectBranchName
newBranchName Semver
ver)
    ProjectBranchNameKind
ProjectBranchNameKind'NothingSpecial -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  currentProjectName <- Cli (ProjectPathG Project ProjectBranch)
Cli.getCurrentProjectPath Cli (ProjectPathG Project ProjectBranch)
-> (ProjectPathG Project ProjectBranch -> ProjectName)
-> Cli ProjectName
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Getting
  ProjectName (ProjectPathG Project ProjectBranch) ProjectName
-> ProjectPathG Project ProjectBranch -> ProjectName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Project -> Const ProjectName Project)
-> ProjectPathG Project ProjectBranch
-> Const ProjectName (ProjectPathG Project ProjectBranch)
#project ((Project -> Const ProjectName Project)
 -> ProjectPathG Project ProjectBranch
 -> Const ProjectName (ProjectPathG Project ProjectBranch))
-> Getting ProjectName Project ProjectName
-> Getting
     ProjectName (ProjectPathG Project ProjectBranch) ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProjectName Project ProjectName
#name)
  let projectName = (ProjectName -> Maybe ProjectName -> ProjectName
forall a. a -> Maybe a -> a
fromMaybe ProjectName
currentProjectName Maybe ProjectName
mayProjectName)
  destProject <- do
    Cli.runTransactionWithRollback
      \forall void. Output -> Transaction void
rollback -> do
        ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
projectName Transaction (Maybe Project)
-> (Transaction (Maybe Project) -> Transaction Project)
-> Transaction Project
forall a b. a -> (a -> b) -> b
& Transaction Project
-> Transaction (Maybe Project) -> Transaction Project
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
          -- We can't make the *first* branch of a project with `branch`; the project has to already exist.
          Output -> Transaction Project
forall void. Output -> Transaction void
rollback (ProjectAndBranch ProjectName ProjectBranchName -> Output
Output.LocalProjectBranchDoesntExist (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName ProjectBranchName
newBranchName))

  -- Compute what we should create the branch from.
  maySrcProjectAndBranch <-
    case sourceI of
      BranchSourceI
Input.BranchSourceI'CurrentContext -> ProjectAndBranch Project ProjectBranch
-> Maybe (ProjectAndBranch Project ProjectBranch)
forall a. a -> Maybe a
Just (ProjectAndBranch Project ProjectBranch
 -> Maybe (ProjectAndBranch Project ProjectBranch))
-> (ProjectPathG Project ProjectBranch
    -> ProjectAndBranch Project ProjectBranch)
-> ProjectPathG Project ProjectBranch
-> Maybe (ProjectAndBranch Project ProjectBranch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (ProjectAndBranch Project ProjectBranch)
  (ProjectPathG Project ProjectBranch)
  (ProjectAndBranch Project ProjectBranch)
-> ProjectPathG Project ProjectBranch
-> ProjectAndBranch Project ProjectBranch
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (ProjectAndBranch Project ProjectBranch)
  (ProjectPathG Project ProjectBranch)
  (ProjectAndBranch Project ProjectBranch)
forall p b p' b' (f :: * -> *).
Functor f =>
(ProjectAndBranch p b -> f (ProjectAndBranch p' b'))
-> ProjectPathG p b -> f (ProjectPathG p' b')
PP.projectAndBranch_ (ProjectPathG Project ProjectBranch
 -> Maybe (ProjectAndBranch Project ProjectBranch))
-> Cli (ProjectPathG Project ProjectBranch)
-> Cli (Maybe (ProjectAndBranch Project ProjectBranch))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli (ProjectPathG Project ProjectBranch)
Cli.getCurrentProjectPath
      BranchSourceI
Input.BranchSourceI'Empty -> Maybe (ProjectAndBranch Project ProjectBranch)
-> Cli (Maybe (ProjectAndBranch Project ProjectBranch))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ProjectAndBranch Project ProjectBranch)
forall a. Maybe a
Nothing
      Input.BranchSourceI'UnresolvedProjectBranch UnresolvedProjectBranch
unresolvedProjectBranch -> do
        pp <- Cli (ProjectPathG Project ProjectBranch)
Cli.getCurrentProjectPath
        Just <$> ProjectUtils.resolveProjectBranchInProject (pp ^. #project) (unresolvedProjectBranch & #branch %~ Just)

  case maySrcProjectAndBranch of
    Just ProjectAndBranch Project ProjectBranch
srcProjectAndBranch -> do
      let description :: Text
description = Text
"Branch created from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text (ProjectAndBranch Project ProjectBranch
srcProjectAndBranch ProjectAndBranch Project ProjectBranch
-> (ProjectAndBranch Project ProjectBranch
    -> ProjectAndBranch ProjectName ProjectBranchName)
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> (a -> b) -> b
& (Project -> ProjectName)
-> (ProjectBranch -> ProjectBranchName)
-> ProjectAndBranch Project ProjectBranch
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b c d.
(a -> b)
-> (c -> d) -> ProjectAndBranch a c -> ProjectAndBranch b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Getting ProjectName Project ProjectName -> Project -> ProjectName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProjectName Project ProjectName
#name) (Getting ProjectBranchName ProjectBranch ProjectBranchName
-> ProjectBranch -> ProjectBranchName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProjectBranchName ProjectBranch ProjectBranchName
#name))
      Cli (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
-> Cli ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Cli
   (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
 -> Cli ())
-> Cli
     (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
-> Cli ()
forall a b. (a -> b) -> a -> b
$ Text
-> CreateFrom
-> Project
-> Transaction ProjectBranchName
-> Cli
     (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
createBranch Text
description (ProjectBranch -> CreateFrom
CreateFrom'ParentBranch (Getting
  ProjectBranch
  (ProjectAndBranch Project ProjectBranch)
  ProjectBranch
-> ProjectAndBranch Project ProjectBranch -> ProjectBranch
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  ProjectBranch
  (ProjectAndBranch Project ProjectBranch)
  ProjectBranch
#branch ProjectAndBranch Project ProjectBranch
srcProjectAndBranch)) Project
destProject (ProjectBranchName -> Transaction ProjectBranchName
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectBranchName
newBranchName)
    Maybe (ProjectAndBranch Project ProjectBranch)
Nothing -> do
      let description :: Text
description = Text
"Empty branch created"
      Cli (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
-> Cli ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Cli
   (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
 -> Cli ())
-> Cli
     (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
-> Cli ()
forall a b. (a -> b) -> a -> b
$ Text
-> CreateFrom
-> Project
-> Transaction ProjectBranchName
-> Cli
     (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
createBranch Text
description CreateFrom
CreateFrom'Nothingness Project
destProject (ProjectBranchName -> Transaction ProjectBranchName
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectBranchName
newBranchName)

  Cli.respond $
    Output.CreatedProjectBranch
      ( case maySrcProjectAndBranch of
          Just ProjectAndBranch Project ProjectBranch
sourceBranch ->
            if ProjectAndBranch Project ProjectBranch
sourceBranch ProjectAndBranch Project ProjectBranch
-> Getting
     ProjectId (ProjectAndBranch Project ProjectBranch) ProjectId
-> ProjectId
forall s a. s -> Getting a s a -> a
^. (Project -> Const ProjectId Project)
-> ProjectAndBranch Project ProjectBranch
-> Const ProjectId (ProjectAndBranch Project ProjectBranch)
#project ((Project -> Const ProjectId Project)
 -> ProjectAndBranch Project ProjectBranch
 -> Const ProjectId (ProjectAndBranch Project ProjectBranch))
-> Getting ProjectId Project ProjectId
-> Getting
     ProjectId (ProjectAndBranch Project ProjectBranch) ProjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProjectId Project ProjectId
#projectId ProjectId -> ProjectId -> Bool
forall a. Eq a => a -> a -> Bool
== Project
destProject Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId
              then ProjectBranchName -> CreatedProjectBranchFrom
Output.CreatedProjectBranchFrom'ParentBranch (ProjectAndBranch Project ProjectBranch
sourceBranch ProjectAndBranch Project ProjectBranch
-> Getting
     ProjectBranchName
     (ProjectAndBranch Project ProjectBranch)
     ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. (ProjectBranch -> Const ProjectBranchName ProjectBranch)
-> ProjectAndBranch Project ProjectBranch
-> Const ProjectBranchName (ProjectAndBranch Project ProjectBranch)
#branch ((ProjectBranch -> Const ProjectBranchName ProjectBranch)
 -> ProjectAndBranch Project ProjectBranch
 -> Const
      ProjectBranchName (ProjectAndBranch Project ProjectBranch))
-> Getting ProjectBranchName ProjectBranch ProjectBranchName
-> Getting
     ProjectBranchName
     (ProjectAndBranch Project ProjectBranch)
     ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProjectBranchName ProjectBranch ProjectBranchName
#name)
              else ProjectAndBranch Project ProjectBranch -> CreatedProjectBranchFrom
Output.CreatedProjectBranchFrom'OtherBranch ProjectAndBranch Project ProjectBranch
sourceBranch
          Maybe (ProjectAndBranch Project ProjectBranch)
Nothing -> CreatedProjectBranchFrom
Output.CreatedProjectBranchFrom'Nothingness
      )
      (projectAndBranchNames & #project .~ projectName)

-- | @createBranch description createFrom project getNewBranchName@:
--
--   1. Creates a new branch row in @project@ at the name from @getNewBranchName@ (failing if branch already exists in @project@).
--   2. Switches to the new branch.
--
-- This bit of functionality is factored out from the main 'handleBranch' handler because it is also called by the
-- @release.draft@ command, which essentially just creates a branch, but with some different output for the user.
--
-- Returns the branch id and name of the newly-created branch.
createBranch ::
  Text ->
  CreateFrom ->
  Sqlite.Project ->
  Sqlite.Transaction ProjectBranchName ->
  Cli (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
createBranch :: Text
-> CreateFrom
-> Project
-> Transaction ProjectBranchName
-> Cli
     (ProjectAndBranch ProjectId ProjectBranchId, ProjectBranchName)
createBranch Text
description CreateFrom
createFrom Project
project Transaction ProjectBranchName
getNewBranchName = do
  let projectId :: ProjectId
projectId = Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId
  Cli.Env {codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  (mayParentBranchId, newBranchCausalHashId) <- case createFrom of
    CreateFrom'ParentBranch ProjectBranch
parentBranch -> Transaction (Maybe ProjectBranchId, CausalHashId)
-> Cli (Maybe ProjectBranchId, CausalHashId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      newBranchCausalHashId <- HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Q.expectProjectBranchHead ProjectBranch
parentBranch.projectId ProjectBranch
parentBranch.branchId
      let parentBranchId = if ProjectBranch
parentBranch.projectId ProjectId -> ProjectId -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectId
projectId then ProjectBranchId -> Maybe ProjectBranchId
forall a. a -> Maybe a
Just ProjectBranch
parentBranch.branchId else Maybe ProjectBranchId
forall a. Maybe a
Nothing
      pure (parentBranchId, newBranchCausalHashId)
    CreateFrom
CreateFrom'Nothingness -> Transaction (Maybe ProjectBranchId, CausalHashId)
-> Cli (Maybe ProjectBranchId, CausalHashId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      (_, causalHashId) <- Transaction (CausalHash, CausalHashId)
Codebase.emptyCausalHash
      pure (Nothing, causalHashId)
    CreateFrom'MergeParents (CreateFromMergeSource, CausalHash, Map Name Text)
_ (ProjectBranch
targetBranch, CausalHash
_, Map Name Text
_) Branch Transaction
namespace -> do
      Transaction (Maybe ProjectBranchId, CausalHashId)
-> Cli (Maybe ProjectBranchId, CausalHashId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
        Codebase IO Symbol Ann -> Branch Transaction -> Transaction ()
forall (m :: * -> *) v a.
Codebase m v a -> Branch Transaction -> Transaction ()
Codebase.putBranchTx Codebase IO Symbol Ann
codebase Branch Transaction
namespace
        newBranchCausalHashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash (Branch Transaction -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch Transaction
namespace)
        pure (Just targetBranch.branchId, newBranchCausalHashId)
    CreateFrom'Update (ProjectBranch
parentBranch, CausalHash
_, Map Name Text
_) Branch IO
namespace -> do
      IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann -> Branch IO -> IO ()
forall (m :: * -> *) v a. Codebase m v a -> Branch m -> m ()
Codebase.putBranch Codebase IO Symbol Ann
codebase Branch IO
namespace
      Transaction (Maybe ProjectBranchId, CausalHashId)
-> Cli (Maybe ProjectBranchId, CausalHashId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
        newBranchCausalHashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash (Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
namespace)
        pure (Just parentBranch.branchId, newBranchCausalHashId)
    CreateFrom'Upgrade (ProjectBranch
parentBranch, CausalHash
_, Map Name Text
_) Branch IO
namespace -> do
      IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann -> Branch IO -> IO ()
forall (m :: * -> *) v a. Codebase m v a -> Branch m -> m ()
Codebase.putBranch Codebase IO Symbol Ann
codebase Branch IO
namespace
      Transaction (Maybe ProjectBranchId, CausalHashId)
-> Cli (Maybe ProjectBranchId, CausalHashId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
        newBranchCausalHashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash (Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
namespace)
        pure (Just parentBranch.branchId, newBranchCausalHashId)
    CreateFrom'CausalHash CausalHash
causalHash -> do
      Transaction (Maybe ProjectBranchId, CausalHashId)
-> Cli (Maybe ProjectBranchId, CausalHashId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
        causalHashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash CausalHash
causalHash
        pure (Nothing, causalHashId)
    CreateFrom'Namespace Branch IO
branch -> do
      IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann -> Branch IO -> IO ()
forall (m :: * -> *) v a. Codebase m v a -> Branch m -> m ()
Codebase.putBranch Codebase IO Symbol Ann
codebase Branch IO
branch
      Transaction (Maybe ProjectBranchId, CausalHashId)
-> Cli (Maybe ProjectBranchId, CausalHashId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
        newBranchCausalHashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash (Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
branch)
        pure (Nothing, newBranchCausalHashId)
  (newBranchName, newBranchId) <-
    Cli.runTransactionWithRollback \forall void. Output -> Transaction void
rollback -> do
      newBranchName <- Transaction ProjectBranchName
getNewBranchName
      Queries.projectBranchExistsByName projectId newBranchName >>= \case
        Bool
True -> Output -> Transaction (ProjectBranchName, ProjectBranchId)
forall void. Output -> Transaction void
rollback (ProjectAndBranch ProjectName ProjectBranchName -> Output
Output.ProjectAndBranchNameAlreadyExists (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (Project
project Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name) ProjectBranchName
newBranchName))
        Bool
False -> do
          -- Here, we are forking to `foo/bar`, where project `foo` does exist, and it does not have a branch named
          -- `bar`, so the fork will succeed.
          newBranchId <- IO ProjectBranchId -> Transaction ProjectBranchId
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (UUID -> ProjectBranchId
ProjectBranchId (UUID -> ProjectBranchId) -> IO UUID -> IO ProjectBranchId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID.nextRandom)
          Queries.insertProjectBranch
            description
            newBranchCausalHashId
            Sqlite.ProjectBranchRow
              { projectId,
                branchId = newBranchId,
                name = newBranchName,
                parentBranchId = mayParentBranchId
              }
          case createFrom of
            CreateFrom'MergeParents
              (CreateFromMergeSource
source, CausalHash
sourceCausalHash, Map Name Text
sourceUniqueTypeGuids)
              (ProjectBranch
targetBranch, CausalHash
targetCausalHash, Map Name Text
targetUniqueTypeGuids)
              Branch Transaction
_ -> do
                sourceCausalHashId <- CausalHash -> Transaction CausalHashId
Queries.expectCausalHashIdByCausalHash CausalHash
sourceCausalHash
                targetCausalHashId <- Queries.expectCausalHashIdByCausalHash targetCausalHash
                case source of
                  CreateFromMergeSource'Local ProjectBranch
sourceBranch -> do
                    ProjectId
-> ProjectBranchId
-> (ProjectBranchId, CausalHashId)
-> (ProjectBranchId, CausalHashId)
-> Transaction ()
Queries.insertMergeBranchLocal
                      ProjectBranch
targetBranch.projectId
                      ProjectBranchId
newBranchId
                      (ProjectBranch
sourceBranch.branchId, CausalHashId
sourceCausalHashId)
                      (ProjectBranch
targetBranch.branchId, CausalHashId
targetCausalHashId)
                  CreateFromMergeSource'Remote RemoteProjectBranch
sourceBranch URI
sourceHost -> do
                    ProjectId
-> ProjectBranchId
-> (RemoteProjectId, RemoteProjectBranchId, URI, CausalHashId)
-> (ProjectBranchId, CausalHashId)
-> Transaction ()
Queries.insertMergeBranchRemote
                      ProjectBranch
targetBranch.projectId
                      ProjectBranchId
newBranchId
                      (RemoteProjectBranch
sourceBranch.projectId, RemoteProjectBranch
sourceBranch.branchId, URI
sourceHost, CausalHashId
sourceCausalHashId)
                      (ProjectBranch
targetBranch.branchId, CausalHashId
targetCausalHashId)
                  CreateFromMergeSource
CreateFromMergeSource'LooseCode -> do
                    ProjectId
-> ProjectBranchId
-> CausalHashId
-> (ProjectBranchId, CausalHashId)
-> Transaction ()
Queries.insertMergeBranchLooseCode
                      ProjectBranch
targetBranch.projectId
                      ProjectBranchId
newBranchId
                      CausalHashId
sourceCausalHashId
                      (ProjectBranch
targetBranch.branchId, CausalHashId
targetCausalHashId)
                -- Create unique type to GUID mapping for source and target namespaces
                Queries.ensureUniqueTypeToGuidMappingForCausalHashId sourceCausalHashId sourceUniqueTypeGuids
                Queries.ensureUniqueTypeToGuidMappingForCausalHashId targetCausalHashId targetUniqueTypeGuids
            CreateFrom'Update (ProjectBranch
parentBranch, CausalHash
parentCausalHash, Map Name Text
parentUniqueTypeGuids) Branch IO
_namespace -> do
              parentCausalHashId <- CausalHash -> Transaction CausalHashId
Queries.expectCausalHashIdByCausalHash CausalHash
parentCausalHash
              Queries.setProjectBranchIsUpdateBranch parentBranch.projectId newBranchId parentCausalHashId
              -- Create unique type to GUID mapping for parent namespace
              Queries.ensureUniqueTypeToGuidMappingForCausalHashId parentCausalHashId parentUniqueTypeGuids
            CreateFrom'Upgrade (ProjectBranch
parentBranch, CausalHash
parentCausalHash, Map Name Text
parentUniqueTypeGuids) Branch IO
_namespace -> do
              parentCausalHashId <- CausalHash -> Transaction CausalHashId
Queries.expectCausalHashIdByCausalHash CausalHash
parentCausalHash
              Queries.setProjectBranchIsUpgradeBranch parentBranch.projectId newBranchId parentCausalHashId
              -- Create unique type to GUID mapping for parent namespace
              Queries.ensureUniqueTypeToGuidMappingForCausalHashId parentCausalHashId parentUniqueTypeGuids
            CreateFrom
_ -> () -> Transaction ()
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          pure (newBranchName, newBranchId)
  let pabIds = ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectId
projectId ProjectBranchId
newBranchId
  Cli.switchProject pabIds
  pure (pabIds, newBranchName)