-- | @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, defaultBranchName, projectNameUserSlug)
import Unison.Sqlite qualified as Sqlite

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
  currentProjectBranch <- Cli (ProjectAndBranch Project ProjectBranch)
Cli.getCurrentProjectAndBranch
  resolvedRemoteNames <- resolveRemoteNames Share.NoSquashedHead currentProjectBranch remoteNames0
  localNames1 <- resolveLocalNames currentProjectBranch resolvedRemoteNames maybeLocalNames0
  cloneInto localNames1 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
            maybeRemoteProject <- ProjectName -> Cli (Maybe RemoteProject)
Share.getProjectByName ProjectName
remoteProjectName
            maybeRemoteBranch <-
              Share.getProjectBranchByName includeSquashed (ProjectAndBranch remoteBranchProjectId remoteBranchName) <&> \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 (maybeRemoteProject, 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 = ProjectBranchName
defaultBranchName
                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
                    { branch = remoteBranch,
                      from = 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
                    { branch :: RemoteProjectBranch
branch = RemoteProjectBranch
remoteBranch,
                      from :: 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
                branchProjectName <-
                  Transaction ProjectName -> Cli ProjectName
forall a. Transaction a -> Cli a
Cli.runTransaction (RemoteProjectId -> URI -> Transaction ProjectName
Queries.expectRemoteProjectName RemoteProjectId
remoteBranchProjectId URI
Share.hardCodedUri)
                Cli.returnEarly $
                  Output.AmbiguousCloneRemote
                    remoteProjectName
                    (ProjectAndBranch branchProjectName 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 <-
        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)
      branch <- expectB (RemoteProjectKey'Id remoteProjectId) branchName
      pure ResolvedRemoteNames {branch, from = ResolvedRemoteNamesFrom'Branch}

    resolveP :: ProjectName -> Cli ResolvedRemoteNames
resolveP ProjectName
projectName = do
      ProjectName -> Cli ()
assertProjectNameHasUserSlug ProjectName
projectName
      branch <- RemoteProjectKey -> ProjectBranchName -> Cli RemoteProjectBranch
expectB (ProjectName -> RemoteProjectKey
RemoteProjectKey'Name ProjectName
projectName) ProjectBranchName
defaultBranchName
      pure ResolvedRemoteNames {branch, from = ResolvedRemoteNamesFrom'Project}

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

    expectB :: RemoteProjectKey -> ProjectBranchName -> Cli RemoteProjectBranch
expectB RemoteProjectKey
remoteProjectKey ProjectBranchName
remoteBranchName =
      case RemoteProjectKey
remoteProjectKey of
        RemoteProjectKey'Id RemoteProjectId
remoteProjectId -> do
          remoteProjectName <- Transaction ProjectName -> Cli ProjectName
forall a. Transaction a -> Cli a
Cli.runTransaction (RemoteProjectId -> URI -> Transaction ProjectName
Queries.expectRemoteProjectName RemoteProjectId
remoteProjectId URI
Share.hardCodedUri)
          ProjectUtils.expectRemoteProjectBranchByName includeSquashed (ProjectAndBranch (remoteProjectId, remoteProjectName) 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)
      ProjectAndBranch LocalProjectKey ProjectBranchName
-> Cli (ProjectAndBranch LocalProjectKey ProjectBranchName)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
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

  branchHead <-
    HasCallStack =>
IncludeSquashedHead
-> RemoteProjectBranch
-> Bool
-> Cli (Either ShareError CausalHash)
IncludeSquashedHead
-> RemoteProjectBranch
-> Bool
-> Cli (Either ShareError CausalHash)
downloadProjectBranchFromShare IncludeSquashedHead
Share.NoSquashedHead RemoteProjectBranch
remoteProjectBranch Bool
False
      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)

  localProjectAndBranch <-
    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
      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
      (localProjectId, localProjectName) <-
        case maybeLocalProject of
          Left ProjectName
localProjectName -> do
            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)
            Queries.insertProject localProjectId localProjectName
            pure (localProjectId, 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)
      localBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom)
      causalHashId <- Q.expectCausalHashIdByCausalHash branchHead
      let 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)
      Queries.insertProjectBranch
        description
        causalHashId
        Sqlite.ProjectBranchRow
          { projectId = localProjectId,
            branchId = localBranchId,
            name = localProjectBranch.branch,
            parentBranchId = Nothing
          }
      Queries.insertBranchRemoteMapping
        localProjectId
        localBranchId
        remoteProjectBranch.projectId
        Share.hardCodedUri
        remoteProjectBranch.branchId
      pure (ProjectAndBranch (localProjectId, localProjectName) localBranchId)

  Cli.respond $
    Output.ClonedProjectBranch
      remoteProjectBranchNames
      ( ProjectAndBranch
          (localProjectAndBranch ^. #project . _2)
          localProjectBranch.branch
      )

  let 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)
  Cli.switchProject 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))
      Either ProjectName Project
-> Transaction (Either ProjectName Project)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Project -> Either ProjectName Project
forall a b. b -> Either a b
Right Project
project)