-- | @clone@-related input handlers
module Unison.Codebase.Editor.HandleInput.ProjectClone
  ( handleClone,
  )
where

import Control.Lens (_2)
import Data.These (These (..))
import Data.UUID.V4 qualified as UUID
import U.Codebase.Sqlite.DbId (ProjectBranchId (..), ProjectId (..))
import U.Codebase.Sqlite.DbId qualified as Sqlite
import U.Codebase.Sqlite.Project qualified as Sqlite (Project (..))
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.DownloadUtils (downloadProjectBranchFromShare)
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli (getCurrentProjectAndBranch)
import Unison.Cli.ProjectUtils qualified as ProjectUtils
import Unison.Cli.Share.Projects qualified as Share
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Prelude
import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectName, projectNameUserSlug)
import Unison.Sqlite qualified as Sqlite
import Witch (unsafeFrom)

data LocalProjectKey
  = LocalProjectKey'Name ProjectName
  | LocalProjectKey'Project Sqlite.Project

data RemoteProjectKey
  = RemoteProjectKey'Id Sqlite.RemoteProjectId
  | RemoteProjectKey'Name ProjectName

-- | Clone a remote branch.
handleClone :: ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Cli ()
handleClone :: ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Cli ()
handleClone ProjectAndBranchNames
remoteNames0 Maybe ProjectAndBranchNames
maybeLocalNames0 = do
  ProjectAndBranch Project ProjectBranch
currentProjectBranch <- Cli (ProjectAndBranch Project ProjectBranch)
Cli.getCurrentProjectAndBranch
  ResolvedRemoteNames
resolvedRemoteNames <- IncludeSquashedHead
-> ProjectAndBranch Project ProjectBranch
-> ProjectAndBranchNames
-> Cli ResolvedRemoteNames
resolveRemoteNames IncludeSquashedHead
Share.NoSquashedHead ProjectAndBranch Project ProjectBranch
currentProjectBranch ProjectAndBranchNames
remoteNames0
  ProjectAndBranch LocalProjectKey ProjectBranchName
localNames1 <- ProjectAndBranch Project ProjectBranch
-> ResolvedRemoteNames
-> Maybe ProjectAndBranchNames
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolveLocalNames ProjectAndBranch Project ProjectBranch
currentProjectBranch ResolvedRemoteNames
resolvedRemoteNames Maybe ProjectAndBranchNames
maybeLocalNames0
  ProjectAndBranch LocalProjectKey ProjectBranchName
-> RemoteProjectBranch -> Cli ()
cloneInto ProjectAndBranch LocalProjectKey ProjectBranchName
localNames1 ResolvedRemoteNames
resolvedRemoteNames.branch

data ResolvedRemoteNames = ResolvedRemoteNames
  { ResolvedRemoteNames -> RemoteProjectBranch
branch :: Share.RemoteProjectBranch,
    ResolvedRemoteNames -> ResolvedRemoteNamesFrom
from :: ResolvedRemoteNamesFrom
  }
  deriving stock ((forall x. ResolvedRemoteNames -> Rep ResolvedRemoteNames x)
-> (forall x. Rep ResolvedRemoteNames x -> ResolvedRemoteNames)
-> Generic ResolvedRemoteNames
forall x. Rep ResolvedRemoteNames x -> ResolvedRemoteNames
forall x. ResolvedRemoteNames -> Rep ResolvedRemoteNames x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResolvedRemoteNames -> Rep ResolvedRemoteNames x
from :: forall x. ResolvedRemoteNames -> Rep ResolvedRemoteNames x
$cto :: forall x. Rep ResolvedRemoteNames x -> ResolvedRemoteNames
to :: forall x. Rep ResolvedRemoteNames x -> ResolvedRemoteNames
Generic)

data ResolvedRemoteNamesFrom
  = ResolvedRemoteNamesFrom'Branch
  | ResolvedRemoteNamesFrom'Project
  | ResolvedRemoteNamesFrom'ProjectAndBranch

-- Resolve remote names to an actual remote branch.
--
--   <project>/           ==>   abort if <project> doesn't have a user slug
--
--   /<branch>            ==>   abort if not in a project
--
--                              otherwise, abort if current branch doesn't have an associated remote project
--
--   <project>/<branch>   ==>   abort if <project> doesn't have a user slug
--
--   <thing>              ==>   if we're not in a project, then treat as if it was <thing>/
--
--                              otherwise, if <thing> doesn't have a user slug, treat it as /<thing>
--
--                              otherwise, if the current branch doesn't have an associated remote project, treat it as
--                              <thing>/
--
--                              otherwise, hit the server, and if <thing>/ xor /<thing> was valid (e.g. cloning the
--                              "@runar/topic" project-or-branch, where the "@runar/topic" branch does exist in the
--                              project in question, and the "@runar/topic" project does not exist), we'll do that,
--                              otherwise abort
resolveRemoteNames ::
  Share.IncludeSquashedHead ->
  (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) ->
  ProjectAndBranchNames ->
  Cli ResolvedRemoteNames
resolveRemoteNames :: IncludeSquashedHead
-> ProjectAndBranch Project ProjectBranch
-> ProjectAndBranchNames
-> Cli ResolvedRemoteNames
resolveRemoteNames IncludeSquashedHead
includeSquashed ProjectAndBranch Project ProjectBranch
currentProjectAndBranch = \case
  ProjectAndBranchNames'Ambiguous ProjectName
remoteProjectName ProjectBranchName
remoteBranchName -> do
    case ProjectName -> Maybe Text
projectNameUserSlug ProjectName
remoteProjectName of
      Maybe Text
Nothing -> ProjectBranchName -> Cli ResolvedRemoteNames
resolveB ProjectBranchName
remoteBranchName
      Just Text
_ ->
        Transaction (Maybe RemoteProjectId) -> Cli (Maybe RemoteProjectId)
forall a. Transaction a -> Cli a
Cli.runTransaction (ProjectAndBranch Project ProjectBranch
-> Transaction (Maybe RemoteProjectId)
loadAssociatedRemoteProjectId ProjectAndBranch Project ProjectBranch
currentProjectAndBranch) Cli (Maybe RemoteProjectId)
-> (Maybe RemoteProjectId -> Cli ResolvedRemoteNames)
-> Cli ResolvedRemoteNames
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 RemoteProjectId
Nothing -> ProjectName -> Cli ResolvedRemoteNames
resolveP ProjectName
remoteProjectName
          Just RemoteProjectId
remoteBranchProjectId -> do
            -- Fetching these in parallel would be an improvement
            Maybe RemoteProject
maybeRemoteProject <- ProjectName -> Cli (Maybe RemoteProject)
Share.getProjectByName ProjectName
remoteProjectName
            Maybe RemoteProjectBranch
maybeRemoteBranch <-
              IncludeSquashedHead
-> ProjectAndBranch RemoteProjectId ProjectBranchName
-> Cli GetProjectBranchResponse
Share.getProjectBranchByName IncludeSquashedHead
includeSquashed (RemoteProjectId
-> ProjectBranchName
-> ProjectAndBranch RemoteProjectId ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch RemoteProjectId
remoteBranchProjectId ProjectBranchName
remoteBranchName) Cli GetProjectBranchResponse
-> (GetProjectBranchResponse -> Maybe RemoteProjectBranch)
-> Cli (Maybe RemoteProjectBranch)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                GetProjectBranchResponse
Share.GetProjectBranchResponseBranchNotFound -> Maybe RemoteProjectBranch
forall a. Maybe a
Nothing
                GetProjectBranchResponse
Share.GetProjectBranchResponseProjectNotFound -> Maybe RemoteProjectBranch
forall a. Maybe a
Nothing
                Share.GetProjectBranchResponseSuccess RemoteProjectBranch
remoteBranch -> RemoteProjectBranch -> Maybe RemoteProjectBranch
forall a. a -> Maybe a
Just RemoteProjectBranch
remoteBranch
            case (Maybe RemoteProject
maybeRemoteProject, Maybe RemoteProjectBranch
maybeRemoteBranch) of
              (Just RemoteProject
remoteProject, Maybe RemoteProjectBranch
Nothing) -> do
                let remoteProjectId :: RemoteProjectId
remoteProjectId = RemoteProject
remoteProject.projectId
                let remoteProjectName :: ProjectName
remoteProjectName = RemoteProject
remoteProject.projectName
                let remoteBranchName :: ProjectBranchName
remoteBranchName = forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"main"
                RemoteProjectBranch
remoteBranch <-
                  IncludeSquashedHead
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
-> Cli RemoteProjectBranch
ProjectUtils.expectRemoteProjectBranchByName
                    IncludeSquashedHead
includeSquashed
                    ((RemoteProjectId, ProjectName)
-> ProjectBranchName
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (RemoteProjectId
remoteProjectId, ProjectName
remoteProjectName) ProjectBranchName
remoteBranchName)
                pure
                  ResolvedRemoteNames
                    { $sel:branch:ResolvedRemoteNames :: RemoteProjectBranch
branch = RemoteProjectBranch
remoteBranch,
                      $sel:from:ResolvedRemoteNames :: ResolvedRemoteNamesFrom
from = ResolvedRemoteNamesFrom
ResolvedRemoteNamesFrom'Project
                    }
              (Maybe RemoteProject
Nothing, Just RemoteProjectBranch
remoteBranch) ->
                ResolvedRemoteNames -> Cli ResolvedRemoteNames
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  ResolvedRemoteNames
                    { $sel:branch:ResolvedRemoteNames :: RemoteProjectBranch
branch = RemoteProjectBranch
remoteBranch,
                      $sel:from:ResolvedRemoteNames :: ResolvedRemoteNamesFrom
from = ResolvedRemoteNamesFrom
ResolvedRemoteNamesFrom'Branch
                    }
              -- Treat neither existing and both existing uniformly as "ambiguous input"
              -- Alternatively, if neither exist, we could instead say "although your input was ambiguous, disambuating
              -- wouldn't help, because we did enough work to know neither thing exists"
              (Maybe RemoteProject, Maybe RemoteProjectBranch)
_ -> do
                ProjectName
branchProjectName <-
                  Transaction ProjectName -> Cli ProjectName
forall a. Transaction a -> Cli a
Cli.runTransaction (RemoteProjectId -> URI -> Transaction ProjectName
Queries.expectRemoteProjectName RemoteProjectId
remoteBranchProjectId URI
Share.hardCodedUri)
                Output -> Cli ResolvedRemoteNames
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli ResolvedRemoteNames)
-> Output -> Cli ResolvedRemoteNames
forall a b. (a -> b) -> a -> b
$
                  ProjectName
-> ProjectAndBranch ProjectName ProjectBranchName -> Output
Output.AmbiguousCloneRemote
                    ProjectName
remoteProjectName
                    (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
branchProjectName ProjectBranchName
remoteBranchName)
  ProjectAndBranchNames'Unambiguous (This ProjectName
p) -> ProjectName -> Cli ResolvedRemoteNames
resolveP ProjectName
p
  ProjectAndBranchNames'Unambiguous (That ProjectBranchName
b) -> ProjectBranchName -> Cli ResolvedRemoteNames
resolveB ProjectBranchName
b
  ProjectAndBranchNames'Unambiguous (These ProjectName
p ProjectBranchName
b) -> ProjectName -> ProjectBranchName -> Cli ResolvedRemoteNames
resolvePB ProjectName
p ProjectBranchName
b
  where
    resolveB :: ProjectBranchName -> Cli ResolvedRemoteNames
resolveB ProjectBranchName
branchName = do
      RemoteProjectId
remoteProjectId <-
        Transaction (Maybe RemoteProjectId) -> Cli (Maybe RemoteProjectId)
forall a. Transaction a -> Cli a
Cli.runTransaction (ProjectAndBranch Project ProjectBranch
-> Transaction (Maybe RemoteProjectId)
loadAssociatedRemoteProjectId ProjectAndBranch Project ProjectBranch
currentProjectAndBranch) Cli (Maybe RemoteProjectId)
-> (Cli (Maybe RemoteProjectId) -> Cli RemoteProjectId)
-> Cli RemoteProjectId
forall a b. a -> (a -> b) -> b
& Cli RemoteProjectId
-> Cli (Maybe RemoteProjectId) -> Cli RemoteProjectId
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
          Output -> Cli RemoteProjectId
forall a. Output -> Cli a
Cli.returnEarly (URI -> ProjectAndBranch Project ProjectBranch -> Output
Output.NoAssociatedRemoteProjectBranch URI
Share.hardCodedUri ProjectAndBranch Project ProjectBranch
currentProjectAndBranch)
      RemoteProjectBranch
branch <- RemoteProjectKey -> ProjectBranchName -> Cli RemoteProjectBranch
expectB (RemoteProjectId -> RemoteProjectKey
RemoteProjectKey'Id RemoteProjectId
remoteProjectId) ProjectBranchName
branchName
      pure ResolvedRemoteNames {RemoteProjectBranch
$sel:branch:ResolvedRemoteNames :: RemoteProjectBranch
branch :: RemoteProjectBranch
branch, $sel:from:ResolvedRemoteNames :: ResolvedRemoteNamesFrom
from = ResolvedRemoteNamesFrom
ResolvedRemoteNamesFrom'Branch}

    resolveP :: ProjectName -> Cli ResolvedRemoteNames
resolveP ProjectName
projectName = do
      ProjectName -> Cli ()
assertProjectNameHasUserSlug ProjectName
projectName
      RemoteProjectBranch
branch <- RemoteProjectKey -> ProjectBranchName -> Cli RemoteProjectBranch
expectB (ProjectName -> RemoteProjectKey
RemoteProjectKey'Name ProjectName
projectName) (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"main")
      pure ResolvedRemoteNames {RemoteProjectBranch
$sel:branch:ResolvedRemoteNames :: RemoteProjectBranch
branch :: RemoteProjectBranch
branch, $sel:from:ResolvedRemoteNames :: ResolvedRemoteNamesFrom
from = ResolvedRemoteNamesFrom
ResolvedRemoteNamesFrom'Project}

    resolvePB :: ProjectName -> ProjectBranchName -> Cli ResolvedRemoteNames
resolvePB ProjectName
projectName ProjectBranchName
branchName = do
      ProjectName -> Cli ()
assertProjectNameHasUserSlug ProjectName
projectName
      RemoteProjectBranch
branch <- RemoteProjectKey -> ProjectBranchName -> Cli RemoteProjectBranch
expectB (ProjectName -> RemoteProjectKey
RemoteProjectKey'Name ProjectName
projectName) ProjectBranchName
branchName
      pure ResolvedRemoteNames {RemoteProjectBranch
$sel:branch:ResolvedRemoteNames :: RemoteProjectBranch
branch :: RemoteProjectBranch
branch, $sel:from:ResolvedRemoteNames :: ResolvedRemoteNamesFrom
from = ResolvedRemoteNamesFrom
ResolvedRemoteNamesFrom'ProjectAndBranch}

    expectB :: RemoteProjectKey -> ProjectBranchName -> Cli RemoteProjectBranch
expectB RemoteProjectKey
remoteProjectKey ProjectBranchName
remoteBranchName =
      case RemoteProjectKey
remoteProjectKey of
        RemoteProjectKey'Id RemoteProjectId
remoteProjectId -> do
          ProjectName
remoteProjectName <- Transaction ProjectName -> Cli ProjectName
forall a. Transaction a -> Cli a
Cli.runTransaction (RemoteProjectId -> URI -> Transaction ProjectName
Queries.expectRemoteProjectName RemoteProjectId
remoteProjectId URI
Share.hardCodedUri)
          IncludeSquashedHead
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
-> Cli RemoteProjectBranch
ProjectUtils.expectRemoteProjectBranchByName IncludeSquashedHead
includeSquashed ((RemoteProjectId, ProjectName)
-> ProjectBranchName
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (RemoteProjectId
remoteProjectId, ProjectName
remoteProjectName) ProjectBranchName
remoteBranchName)
        RemoteProjectKey'Name ProjectName
remoteProjectName ->
          IncludeSquashedHead
-> ProjectAndBranch ProjectName ProjectBranchName
-> Cli RemoteProjectBranch
ProjectUtils.expectRemoteProjectBranchByNames IncludeSquashedHead
includeSquashed (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
remoteProjectName ProjectBranchName
remoteBranchName)

-- Resolve the local names to an actual local project (which may not exist yet), aborting on nonsense
-- inputs:
--
--   <project>/           ==>   if we already know the remote branch name is <branch>, abort if <project>/<branch>
--                              already exists
--
--   /<branch>            ==>   abort if not in a project
--
--                              abort if <branch> already exists in this project
--
--   <project>/<branch>   ==>   abort if <project>/<branch> already exists
--
--   <thing>              ==>   if we're not in a project, then treat as if it was <thing>/
--
--                              otherwise, <thing> is ambiguous, as we don't know if the user wants to clone into
--                              <thing>/<branch> (where <branch> is determined by the name of the remote branch we
--                              are cloning), or /<thing>
--
-- The resolved remote names are used to fill in missing local names (i.e. a one-argument clone). For example, if
-- `clone @foo/bar` resulted in treating `@foo/bar` as a contributor branch of the current project, then it is as if
-- the user typed `clone /@foo/bar` instead, which is equivalent to the two-arg `clone /@foo/bar /@foo/bar`.
resolveLocalNames ::
  (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) ->
  ResolvedRemoteNames ->
  Maybe ProjectAndBranchNames ->
  Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolveLocalNames :: ProjectAndBranch Project ProjectBranch
-> ResolvedRemoteNames
-> Maybe ProjectAndBranchNames
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolveLocalNames (ProjectAndBranch Project
currentProject ProjectBranch
_) ResolvedRemoteNames
resolvedRemoteNames Maybe ProjectAndBranchNames
maybeLocalNames =
  ProjectAndBranchNames
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolve case Maybe ProjectAndBranchNames
maybeLocalNames of
    Maybe ProjectAndBranchNames
Nothing ->
      These ProjectName ProjectBranchName -> ProjectAndBranchNames
ProjectAndBranchNames'Unambiguous case ResolvedRemoteNames
resolvedRemoteNames.from of
        ResolvedRemoteNamesFrom
ResolvedRemoteNamesFrom'Branch -> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectBranchName
remoteBranchName
        ResolvedRemoteNamesFrom
ResolvedRemoteNamesFrom'Project -> ProjectName -> These ProjectName ProjectBranchName
forall a b. a -> These a b
This ProjectName
remoteProjectName
        ResolvedRemoteNamesFrom
ResolvedRemoteNamesFrom'ProjectAndBranch -> ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
remoteProjectName ProjectBranchName
remoteBranchName
    Just ProjectAndBranchNames
localNames -> ProjectAndBranchNames
localNames
  where
    remoteBranchName :: ProjectBranchName
remoteBranchName = ResolvedRemoteNames
resolvedRemoteNames.branch.branchName
    remoteProjectName :: ProjectName
remoteProjectName = ResolvedRemoteNames
resolvedRemoteNames.branch.projectName

    resolve :: ProjectAndBranchNames
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolve ProjectAndBranchNames
names =
      case ProjectAndBranchNames
names of
        ProjectAndBranchNames'Ambiguous ProjectName
localProjectName ProjectBranchName
localBranchName -> do
          Output -> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
forall a. Output -> Cli a
Cli.returnEarly (Output
 -> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName))
-> Output
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
forall a b. (a -> b) -> a -> b
$
            ProjectAndBranch ProjectName ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName -> Output
Output.AmbiguousCloneLocal
              (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
localProjectName ProjectBranchName
remoteBranchName)
              (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
currentProject.name ProjectBranchName
localBranchName)
        ProjectAndBranchNames'Unambiguous (This ProjectName
localProjectName) -> ProjectName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolveP ProjectName
localProjectName
        ProjectAndBranchNames'Unambiguous (That ProjectBranchName
localBranchName) -> ProjectBranchName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolveB ProjectBranchName
localBranchName
        ProjectAndBranchNames'Unambiguous (These ProjectName
localProjectName ProjectBranchName
localBranchName) -> ProjectName
-> ProjectBranchName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolvePB ProjectName
localProjectName ProjectBranchName
localBranchName

    resolveP :: ProjectName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolveP ProjectName
localProjectName =
      LocalProjectKey
-> ProjectBranchName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
go (ProjectName -> LocalProjectKey
LocalProjectKey'Name ProjectName
localProjectName) ProjectBranchName
remoteBranchName

    resolveB :: ProjectBranchName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolveB ProjectBranchName
localBranchName = do
      LocalProjectKey
-> ProjectBranchName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
go (Project -> LocalProjectKey
LocalProjectKey'Project Project
currentProject) ProjectBranchName
localBranchName

    resolvePB :: ProjectName
-> ProjectBranchName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
resolvePB ProjectName
localProjectName ProjectBranchName
localBranchName =
      LocalProjectKey
-> ProjectBranchName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
go (ProjectName -> LocalProjectKey
LocalProjectKey'Name ProjectName
localProjectName) ProjectBranchName
localBranchName

    go :: LocalProjectKey
-> ProjectBranchName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
go LocalProjectKey
project ProjectBranchName
branch = do
      Cli (Either ProjectName Project) -> Cli ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Cli (Either ProjectName Project) -> Cli ())
-> Cli (Either ProjectName Project) -> Cli ()
forall a b. (a -> b) -> a -> b
$
        ((forall void. Output -> Transaction void)
 -> Transaction (Either ProjectName Project))
-> Cli (Either ProjectName Project)
forall a.
((forall void. Output -> Transaction void) -> Transaction a)
-> Cli a
Cli.runTransactionWithRollback \forall void. Output -> Transaction void
rollback ->
          (forall void. Output -> Transaction void)
-> ProjectAndBranch LocalProjectKey ProjectBranchName
-> Transaction (Either ProjectName Project)
assertLocalProjectBranchDoesntExist Output -> Transaction void
forall void. Output -> Transaction void
rollback (LocalProjectKey
-> ProjectBranchName
-> ProjectAndBranch LocalProjectKey ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch LocalProjectKey
project ProjectBranchName
branch)
      pure (LocalProjectKey
-> ProjectBranchName
-> ProjectAndBranch LocalProjectKey ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch LocalProjectKey
project ProjectBranchName
branch)

-- `cloneInto command local remote` clones `remote` into `local`, which is believed to not exist yet, but may (because
-- it takes some time to pull the remote).
cloneInto :: ProjectAndBranch LocalProjectKey ProjectBranchName -> Share.RemoteProjectBranch -> Cli ()
cloneInto :: ProjectAndBranch LocalProjectKey ProjectBranchName
-> RemoteProjectBranch -> Cli ()
cloneInto ProjectAndBranch LocalProjectKey ProjectBranchName
localProjectBranch RemoteProjectBranch
remoteProjectBranch = do
  let remoteProjectName :: ProjectName
remoteProjectName = RemoteProjectBranch
remoteProjectBranch.projectName
  let remoteBranchName :: ProjectBranchName
remoteBranchName = RemoteProjectBranch
remoteProjectBranch.branchName
  let remoteProjectBranchNames :: ProjectAndBranch ProjectName ProjectBranchName
remoteProjectBranchNames = ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
remoteProjectName ProjectBranchName
remoteBranchName

  CausalHash
branchHead <-
    HasCallStack =>
IncludeSquashedHead
-> RemoteProjectBranch -> Cli (Either ShareError CausalHash)
IncludeSquashedHead
-> RemoteProjectBranch -> Cli (Either ShareError CausalHash)
downloadProjectBranchFromShare IncludeSquashedHead
Share.NoSquashedHead RemoteProjectBranch
remoteProjectBranch
      Cli (Either ShareError CausalHash)
-> (Cli (Either ShareError CausalHash) -> Cli CausalHash)
-> Cli CausalHash
forall a b. a -> (a -> b) -> b
& (ShareError -> Cli CausalHash)
-> Cli (Either ShareError CausalHash) -> Cli CausalHash
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM (Output -> Cli CausalHash
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli CausalHash)
-> (ShareError -> Output) -> ShareError -> Cli CausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareError -> Output
Output.ShareError)

  ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId
localProjectAndBranch <-
    ((forall void. Output -> Transaction void)
 -> Transaction
      (ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId))
-> Cli (ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId)
forall a.
((forall void. Output -> Transaction void) -> Transaction a)
-> Cli a
Cli.runTransactionWithRollback \forall void. Output -> Transaction void
rollback -> do
      -- Repeat the check from before, because (although it's highly unlikely) we could have a name conflict after
      -- downloading the remote branch
      Either ProjectName Project
maybeLocalProject <- (forall void. Output -> Transaction void)
-> ProjectAndBranch LocalProjectKey ProjectBranchName
-> Transaction (Either ProjectName Project)
assertLocalProjectBranchDoesntExist Output -> Transaction void
forall void. Output -> Transaction void
rollback ProjectAndBranch LocalProjectKey ProjectBranchName
localProjectBranch
      -- Create the local project (if necessary), and create the local branch
      (ProjectId
localProjectId, ProjectName
localProjectName) <-
        case Either ProjectName Project
maybeLocalProject of
          Left ProjectName
localProjectName -> do
            ProjectId
localProjectId <- IO ProjectId -> Transaction ProjectId
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (UUID -> ProjectId
ProjectId (UUID -> ProjectId) -> IO UUID -> IO ProjectId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID.nextRandom)
            ProjectId -> ProjectName -> Transaction ()
Queries.insertProject ProjectId
localProjectId ProjectName
localProjectName
            pure (ProjectId
localProjectId, ProjectName
localProjectName)
          Right Project
localProject -> (ProjectId, ProjectName) -> Transaction (ProjectId, ProjectName)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Project
localProject.projectId, Project
localProject.name)
      ProjectBranchId
localBranchId <- 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)
      CausalHashId
causalHashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash CausalHash
branchHead
      let description :: Text
description = Text
"Cloned from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
remoteProjectName ProjectBranchName
remoteBranchName)
      HasCallStack =>
Text -> CausalHashId -> ProjectBranch -> Transaction ()
Text -> CausalHashId -> ProjectBranch -> Transaction ()
Queries.insertProjectBranch
        Text
description
        CausalHashId
causalHashId
        Sqlite.ProjectBranch
          { $sel:projectId:ProjectBranch :: ProjectId
projectId = ProjectId
localProjectId,
            $sel:branchId:ProjectBranch :: ProjectBranchId
branchId = ProjectBranchId
localBranchId,
            $sel:name:ProjectBranch :: ProjectBranchName
name = ProjectAndBranch LocalProjectKey ProjectBranchName
localProjectBranch.branch,
            $sel:parentBranchId:ProjectBranch :: Maybe ProjectBranchId
parentBranchId = Maybe ProjectBranchId
forall a. Maybe a
Nothing
          }
      ProjectId
-> ProjectBranchId
-> RemoteProjectId
-> URI
-> RemoteProjectBranchId
-> Transaction ()
Queries.insertBranchRemoteMapping
        ProjectId
localProjectId
        ProjectBranchId
localBranchId
        RemoteProjectBranch
remoteProjectBranch.projectId
        URI
Share.hardCodedUri
        RemoteProjectBranch
remoteProjectBranch.branchId
      pure ((ProjectId, ProjectName)
-> ProjectBranchId
-> ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (ProjectId
localProjectId, ProjectName
localProjectName) ProjectBranchId
localBranchId)

  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$
    ProjectAndBranch ProjectName ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName -> Output
Output.ClonedProjectBranch
      ProjectAndBranch ProjectName ProjectBranchName
remoteProjectBranchNames
      ( ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch
          (ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId
localProjectAndBranch ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId
-> Getting
     ProjectName
     (ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId)
     ProjectName
-> ProjectName
forall s a. s -> Getting a s a -> a
^. ((ProjectId, ProjectName)
 -> Const ProjectName (ProjectId, ProjectName))
-> ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId
-> Const
     ProjectName
     (ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId)
#project (((ProjectId, ProjectName)
  -> Const ProjectName (ProjectId, ProjectName))
 -> ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId
 -> Const
      ProjectName
      (ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId))
-> ((ProjectName -> Const ProjectName ProjectName)
    -> (ProjectId, ProjectName)
    -> Const ProjectName (ProjectId, ProjectName))
-> Getting
     ProjectName
     (ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId)
     ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectName -> Const ProjectName ProjectName)
-> (ProjectId, ProjectName)
-> Const ProjectName (ProjectId, ProjectName)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (ProjectId, ProjectName)
  (ProjectId, ProjectName)
  ProjectName
  ProjectName
_2)
          ProjectAndBranch LocalProjectKey ProjectBranchName
localProjectBranch.branch
      )

  let newProjectAndBranch :: ProjectAndBranch ProjectId ProjectBranchId
newProjectAndBranch = (ASetter
  (ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId)
  (ProjectAndBranch ProjectId ProjectBranchId)
  (ProjectId, ProjectName)
  ProjectId
-> ((ProjectId, ProjectName) -> ProjectId)
-> ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId
-> ProjectAndBranch ProjectId ProjectBranchId
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId)
  (ProjectAndBranch ProjectId ProjectBranchId)
  (ProjectId, ProjectName)
  ProjectId
#project (ProjectId, ProjectName) -> ProjectId
forall a b. (a, b) -> a
fst ProjectAndBranch (ProjectId, ProjectName) ProjectBranchId
localProjectAndBranch)
  ProjectAndBranch ProjectId ProjectBranchId -> Cli ()
Cli.switchProject ProjectAndBranch ProjectId ProjectBranchId
newProjectAndBranch

-- Return the remote project id associated with the given project branch
loadAssociatedRemoteProjectId ::
  ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch ->
  Sqlite.Transaction (Maybe Sqlite.RemoteProjectId)
loadAssociatedRemoteProjectId :: ProjectAndBranch Project ProjectBranch
-> Transaction (Maybe RemoteProjectId)
loadAssociatedRemoteProjectId (ProjectAndBranch Project
project ProjectBranch
branch) =
  ((RemoteProjectId, Maybe RemoteProjectBranchId) -> RemoteProjectId)
-> Maybe (RemoteProjectId, Maybe RemoteProjectBranchId)
-> Maybe RemoteProjectId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RemoteProjectId, Maybe RemoteProjectBranchId) -> RemoteProjectId
forall a b. (a, b) -> a
fst (Maybe (RemoteProjectId, Maybe RemoteProjectBranchId)
 -> Maybe RemoteProjectId)
-> Transaction
     (Maybe (RemoteProjectId, Maybe RemoteProjectBranchId))
-> Transaction (Maybe RemoteProjectId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectId
-> URI
-> ProjectBranchId
-> Transaction
     (Maybe (RemoteProjectId, Maybe RemoteProjectBranchId))
Queries.loadRemoteProjectBranch ProjectId
projectId URI
Share.hardCodedUri ProjectBranchId
branchId
  where
    projectId :: ProjectId
projectId = Project
project.projectId
    branchId :: ProjectBranchId
branchId = ProjectBranch
branch.branchId

assertProjectNameHasUserSlug :: ProjectName -> Cli ()
assertProjectNameHasUserSlug :: ProjectName -> Cli ()
assertProjectNameHasUserSlug ProjectName
projectName =
  Cli Text -> Cli ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Cli Text -> Cli ()) -> Cli Text -> Cli ()
forall a b. (a -> b) -> a -> b
$
    ProjectName -> Maybe Text
projectNameUserSlug ProjectName
projectName
      Maybe Text -> (Maybe Text -> Cli Text) -> Cli Text
forall a b. a -> (a -> b) -> b
& Cli Text -> Maybe Text -> Cli Text
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing (Output -> Cli Text
forall a. Output -> Cli a
Cli.returnEarly (ProjectName -> Output
Output.ProjectNameRequiresUserSlug ProjectName
projectName))

-- Assert that a local project+branch with this name doesn't already exist. If it does exist, we can't clone over it.
assertLocalProjectBranchDoesntExist ::
  (forall void. Output.Output -> Sqlite.Transaction void) ->
  ProjectAndBranch LocalProjectKey ProjectBranchName ->
  Sqlite.Transaction (Either ProjectName Sqlite.Project)
assertLocalProjectBranchDoesntExist :: (forall void. Output -> Transaction void)
-> ProjectAndBranch LocalProjectKey ProjectBranchName
-> Transaction (Either ProjectName Project)
assertLocalProjectBranchDoesntExist forall void. Output -> Transaction void
rollback = \case
  ProjectAndBranch (LocalProjectKey'Name ProjectName
projectName) ProjectBranchName
branchName ->
    ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
projectName Transaction (Maybe Project)
-> (Maybe Project -> Transaction (Either ProjectName Project))
-> Transaction (Either ProjectName Project)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Project
Nothing -> Either ProjectName Project
-> Transaction (Either ProjectName Project)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName -> Either ProjectName Project
forall a b. a -> Either a b
Left ProjectName
projectName)
      Just Project
project -> Project
-> ProjectBranchName -> Transaction (Either ProjectName Project)
go Project
project ProjectBranchName
branchName
  ProjectAndBranch (LocalProjectKey'Project Project
project) ProjectBranchName
branchName -> Project
-> ProjectBranchName -> Transaction (Either ProjectName Project)
go Project
project ProjectBranchName
branchName
  where
    go :: Project
-> ProjectBranchName -> Transaction (Either ProjectName Project)
go Project
project ProjectBranchName
branchName = do
      ProjectId -> ProjectBranchName -> Transaction Bool
Queries.projectBranchExistsByName Project
project.projectId ProjectBranchName
branchName Transaction Bool
-> (Transaction Bool -> Transaction ()) -> Transaction ()
forall a b. a -> (a -> b) -> b
& Transaction () -> Transaction Bool -> Transaction ()
forall (m :: * -> *). Monad m => m () -> m Bool -> m ()
onTrueM do
        Output -> Transaction ()
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.name ProjectBranchName
branchName))
      pure (Project -> Either ProjectName Project
forall a b. b -> Either a b
Right Project
project)