-- | Project-related utilities.
module Unison.Cli.ProjectUtils
  ( -- * Project/path helpers
    expectProjectBranchByName,
    resolveBranchRelativePath,
    resolveProjectBranch,
    resolveProjectBranchInProject,

    -- * Name hydration
    hydrateNames,

    -- * Loading local project info
    expectProjectAndBranchByIds,
    getProjectAndBranchByTheseNames,
    getProjectAndBranchByNames,
    expectProjectAndBranchByTheseNames,
    getProjectBranchCausalHash,

    -- * Loading remote project info
    expectRemoteProjectById,
    expectRemoteProjectByName,
    expectRemoteProjectBranchById,
    loadRemoteProjectBranchByName,
    expectRemoteProjectBranchByName,
    loadRemoteProjectBranchByNames,
    expectRemoteProjectBranchByNames,
    expectRemoteProjectBranchByTheseNames,

    -- * Projecting out common things
    justTheIds,
    justTheIds',
    justTheNames,

    -- * Other helpers
    findTemporaryBranchName,
    expectLatestReleaseBranchName,

    -- * Merge/upgrade branch utils
    getMergeBranchParent,
    getUpgradeBranchParent,
  )
where

import Control.Lens
import Data.List qualified as List
import Data.Maybe (fromJust)
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.These (These (..))
import U.Codebase.HashTags (CausalHash)
import U.Codebase.Sqlite.DbId
import U.Codebase.Sqlite.Project (Project)
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.Share.Projects (IncludeSquashedHead)
import Unison.Cli.Share.Projects qualified as Share
import Unison.Codebase.Editor.Output (Output (LocalProjectBranchDoesntExist))
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath qualified as PP
import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..))
import Unison.Core.Project (ProjectBranchName (..))
import Unison.Prelude
import Unison.Project (ProjectAndBranch (..), ProjectName)
import Unison.Sqlite (Transaction)
import Unison.Sqlite qualified as Sqlite
import Witch (unsafeFrom)

resolveBranchRelativePath :: BranchRelativePath -> Cli PP.ProjectPath
resolveBranchRelativePath :: BranchRelativePath -> Cli ProjectPath
resolveBranchRelativePath BranchRelativePath
brp = do
  case BranchRelativePath
brp of
    BranchPathInCurrentProject ProjectBranchName
projBranchName Absolute
path -> do
      ProjectAndBranch Project ProjectBranch
projectAndBranch <- These ProjectName ProjectBranchName
-> Cli (ProjectAndBranch Project ProjectBranch)
expectProjectAndBranchByTheseNames (ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectBranchName
projBranchName)
      pure $ ProjectAndBranch Project ProjectBranch -> Absolute -> ProjectPath
PP.fromProjectAndBranch ProjectAndBranch Project ProjectBranch
projectAndBranch Absolute
path
    QualifiedBranchPath ProjectName
projName ProjectBranchName
projBranchName Absolute
path -> do
      ProjectAndBranch Project ProjectBranch
projectAndBranch <- These ProjectName ProjectBranchName
-> Cli (ProjectAndBranch Project ProjectBranch)
expectProjectAndBranchByTheseNames (ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
projName ProjectBranchName
projBranchName)
      pure $ ProjectAndBranch Project ProjectBranch -> Absolute -> ProjectPath
PP.fromProjectAndBranch ProjectAndBranch Project ProjectBranch
projectAndBranch Absolute
path
    UnqualifiedPath Path'
newPath' -> do
      ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
      pure $ ProjectPath
pp ProjectPath -> (ProjectPath -> ProjectPath) -> ProjectPath
forall a b. a -> (a -> b) -> b
& (Absolute -> Identity Absolute)
-> ProjectPath -> Identity ProjectPath
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ ((Absolute -> Identity Absolute)
 -> ProjectPath -> Identity ProjectPath)
-> (Absolute -> Absolute) -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Absolute
curPath -> Absolute -> Path' -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
curPath Path'
newPath'

justTheIds :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> ProjectAndBranch ProjectId ProjectBranchId
justTheIds :: ProjectAndBranch Project ProjectBranch
-> ProjectAndBranch ProjectId ProjectBranchId
justTheIds ProjectAndBranch Project ProjectBranch
x =
  ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectAndBranch Project ProjectBranch
x.project.projectId ProjectAndBranch Project ProjectBranch
x.branch.branchId

justTheIds' :: Sqlite.ProjectBranch -> ProjectAndBranch ProjectId ProjectBranchId
justTheIds' :: ProjectBranch -> ProjectAndBranch ProjectId ProjectBranchId
justTheIds' ProjectBranch
branch =
  ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectBranch
branch.projectId ProjectBranch
branch.branchId

justTheNames :: ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch -> ProjectAndBranch ProjectName ProjectBranchName
justTheNames :: ProjectAndBranch Project ProjectBranch
-> ProjectAndBranch ProjectName ProjectBranchName
justTheNames ProjectAndBranch Project ProjectBranch
x =
  ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectAndBranch Project ProjectBranch
x.project.name ProjectAndBranch Project ProjectBranch
x.branch.name

-- @findTemporaryBranchName projectId preferred@ finds some unused branch name in @projectId@ with a name
-- like @preferred@.
findTemporaryBranchName :: ProjectId -> ProjectBranchName -> Transaction ProjectBranchName
findTemporaryBranchName :: ProjectId -> ProjectBranchName -> Transaction ProjectBranchName
findTemporaryBranchName ProjectId
projectId ProjectBranchName
preferred = do
  Set ProjectBranchName
allBranchNames <-
    ([(ProjectBranchId, ProjectBranchName)] -> Set ProjectBranchName)
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> Transaction (Set ProjectBranchName)
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ProjectBranchName] -> Set ProjectBranchName
forall a. Ord a => [a] -> Set a
Set.fromList ([ProjectBranchName] -> Set ProjectBranchName)
-> ([(ProjectBranchId, ProjectBranchName)] -> [ProjectBranchName])
-> [(ProjectBranchId, ProjectBranchName)]
-> Set ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ProjectBranchId, ProjectBranchName) -> ProjectBranchName)
-> [(ProjectBranchId, ProjectBranchName)] -> [ProjectBranchName]
forall a b. (a -> b) -> [a] -> [b]
map (ProjectBranchId, ProjectBranchName) -> ProjectBranchName
forall a b. (a, b) -> b
snd) do
      ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Queries.loadAllProjectBranchesBeginningWith ProjectId
projectId Maybe Text
forall a. Maybe a
Nothing

  let -- all branch name candidates in order of preference:
      --   prefix
      --   prefix-2
      --   prefix-3
      --   ...
      allCandidates :: [ProjectBranchName]
      allCandidates :: [ProjectBranchName]
allCandidates =
        ProjectBranchName
preferred ProjectBranchName -> [ProjectBranchName] -> [ProjectBranchName]
forall a. a -> [a] -> [a]
: do
          Int
n <- [(Int
2 :: Int) ..]
          pure (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text (forall target source. From source target => source -> target
into @Text ProjectBranchName
preferred Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tShow Int
n))

  pure (Maybe ProjectBranchName -> ProjectBranchName
forall a. HasCallStack => Maybe a -> a
fromJust ((ProjectBranchName -> Bool)
-> [ProjectBranchName] -> Maybe ProjectBranchName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\ProjectBranchName
name -> Bool -> Bool
not (ProjectBranchName -> Set ProjectBranchName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ProjectBranchName
name Set ProjectBranchName
allBranchNames)) [ProjectBranchName]
allCandidates))

expectProjectBranchByName :: Sqlite.Project -> ProjectBranchName -> Cli Sqlite.ProjectBranch
expectProjectBranchByName :: Project -> ProjectBranchName -> Cli ProjectBranch
expectProjectBranchByName Project
project ProjectBranchName
branchName =
  Transaction (Maybe ProjectBranch) -> Cli (Maybe ProjectBranch)
forall a. Transaction a -> Cli a
Cli.runTransaction (ProjectId -> ProjectBranchName -> Transaction (Maybe ProjectBranch)
Queries.loadProjectBranchByName (Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId) ProjectBranchName
branchName) Cli (Maybe ProjectBranch)
-> (Cli (Maybe ProjectBranch) -> Cli ProjectBranch)
-> Cli ProjectBranch
forall a b. a -> (a -> b) -> b
& Cli ProjectBranch -> Cli (Maybe ProjectBranch) -> Cli ProjectBranch
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
    Output -> Cli ProjectBranch
forall a. Output -> Cli a
Cli.returnEarly (ProjectAndBranch ProjectName ProjectBranchName -> Output
LocalProjectBranchDoesntExist (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
branchName))

-- We often accept a `These ProjectName ProjectBranchName` from the user, so they can leave off either a project or
-- branch name, which we infer. This helper "hydrates" such a type to a `(ProjectName, BranchName)`, using the following
-- defaults if a name is missing:
--
--   * The project at the current path
--   * The branch named "main"
hydrateNames :: These ProjectName ProjectBranchName -> Cli (ProjectAndBranch ProjectName ProjectBranchName)
hydrateNames :: These ProjectName ProjectBranchName
-> Cli (ProjectAndBranch ProjectName ProjectBranchName)
hydrateNames = \case
  This ProjectName
projectName -> ProjectAndBranch ProjectName ProjectBranchName
-> Cli (ProjectAndBranch ProjectName ProjectBranchName)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"main"))
  That ProjectBranchName
branchName -> do
    ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
    pure (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (ProjectPath
pp ProjectPath
-> Getting ProjectName ProjectPath ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. (Project -> Const ProjectName Project)
-> ProjectPath -> Const ProjectName ProjectPath
#project ((Project -> Const ProjectName Project)
 -> ProjectPath -> Const ProjectName ProjectPath)
-> Getting ProjectName Project ProjectName
-> Getting ProjectName ProjectPath ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProjectName Project ProjectName
#name) ProjectBranchName
branchName)
  These ProjectName
projectName ProjectBranchName
branchName -> ProjectAndBranch ProjectName ProjectBranchName
-> Cli (ProjectAndBranch ProjectName ProjectBranchName)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName)

getProjectAndBranchByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
getProjectAndBranchByNames :: ProjectAndBranch ProjectName ProjectBranchName
-> Transaction (Maybe (ProjectAndBranch Project ProjectBranch))
getProjectAndBranchByNames (ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName) =
  MaybeT Transaction (ProjectAndBranch Project ProjectBranch)
-> Transaction (Maybe (ProjectAndBranch Project ProjectBranch))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    Project
project <- Transaction (Maybe Project) -> MaybeT Transaction Project
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
projectName)
    ProjectBranch
branch <- Transaction (Maybe ProjectBranch)
-> MaybeT Transaction ProjectBranch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ProjectId -> ProjectBranchName -> Transaction (Maybe ProjectBranch)
Queries.loadProjectBranchByName (Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId) ProjectBranchName
branchName)
    pure (Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
project ProjectBranch
branch)

-- Expect a local project+branch by ids.
expectProjectAndBranchByIds ::
  ProjectAndBranch ProjectId ProjectBranchId ->
  Sqlite.Transaction (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
expectProjectAndBranchByIds :: ProjectAndBranch ProjectId ProjectBranchId
-> Transaction (ProjectAndBranch Project ProjectBranch)
expectProjectAndBranchByIds (ProjectAndBranch ProjectId
projectId ProjectBranchId
branchId) = do
  Project
project <- ProjectId -> Transaction Project
Queries.expectProject ProjectId
projectId
  ProjectBranch
branch <- ProjectId -> ProjectBranchId -> Transaction ProjectBranch
Queries.expectProjectBranch ProjectId
projectId ProjectBranchId
branchId
  pure (Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
project ProjectBranch
branch)

-- Get a local project branch by a "these names", using the following defaults if a name is missing:
--
--   * The project at the current path
--   * The branch named "main"
getProjectAndBranchByTheseNames ::
  These ProjectName ProjectBranchName ->
  Cli (Maybe (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
getProjectAndBranchByTheseNames :: These ProjectName ProjectBranchName
-> Cli (Maybe (ProjectAndBranch Project ProjectBranch))
getProjectAndBranchByTheseNames = \case
  This ProjectName
projectName -> These ProjectName ProjectBranchName
-> Cli (Maybe (ProjectAndBranch Project ProjectBranch))
getProjectAndBranchByTheseNames (ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
projectName (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"main"))
  That ProjectBranchName
branchName -> MaybeT Cli (ProjectAndBranch Project ProjectBranch)
-> Cli (Maybe (ProjectAndBranch Project ProjectBranch))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    (PP.ProjectPath Project
proj ProjectBranch
_branch Absolute
_path) <- Cli ProjectPath -> MaybeT Cli ProjectPath
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Cli ProjectPath
Cli.getCurrentProjectPath
    ProjectBranch
branch <- Cli (Maybe ProjectBranch) -> MaybeT Cli ProjectBranch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe ProjectBranch) -> Cli (Maybe ProjectBranch)
forall a. Transaction a -> Cli a
Cli.runTransaction (ProjectId -> ProjectBranchName -> Transaction (Maybe ProjectBranch)
Queries.loadProjectBranchByName (Project
proj Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId) ProjectBranchName
branchName))
    pure (Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
proj ProjectBranch
branch)
  These ProjectName
projectName ProjectBranchName
branchName -> do
    Transaction (Maybe (ProjectAndBranch Project ProjectBranch))
-> Cli (Maybe (ProjectAndBranch Project ProjectBranch))
forall a. Transaction a -> Cli a
Cli.runTransaction do
      MaybeT Transaction (ProjectAndBranch Project ProjectBranch)
-> Transaction (Maybe (ProjectAndBranch Project ProjectBranch))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
        Project
project <- Transaction (Maybe Project) -> MaybeT Transaction Project
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
projectName)
        ProjectBranch
branch <- Transaction (Maybe ProjectBranch)
-> MaybeT Transaction ProjectBranch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ProjectId -> ProjectBranchName -> Transaction (Maybe ProjectBranch)
Queries.loadProjectBranchByName (Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId) ProjectBranchName
branchName)
        pure (Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
project ProjectBranch
branch)

-- Expect a local project branch by a "these names", using the following defaults if a name is missing:
--
--   * The project at the current path
--   * The branch named "main"
expectProjectAndBranchByTheseNames ::
  These ProjectName ProjectBranchName ->
  Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
expectProjectAndBranchByTheseNames :: These ProjectName ProjectBranchName
-> Cli (ProjectAndBranch Project ProjectBranch)
expectProjectAndBranchByTheseNames = \case
  This ProjectName
projectName -> These ProjectName ProjectBranchName
-> Cli (ProjectAndBranch Project ProjectBranch)
expectProjectAndBranchByTheseNames (ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
projectName (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"main"))
  That ProjectBranchName
branchName -> do
    PP.ProjectPath Project
project ProjectBranch
_branch Absolute
_restPath <- Cli ProjectPath
Cli.getCurrentProjectPath
    ProjectBranch
branch <-
      Transaction (Maybe ProjectBranch) -> Cli (Maybe ProjectBranch)
forall a. Transaction a -> Cli a
Cli.runTransaction (ProjectId -> ProjectBranchName -> Transaction (Maybe ProjectBranch)
Queries.loadProjectBranchByName (Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId) ProjectBranchName
branchName) Cli (Maybe ProjectBranch)
-> (Cli (Maybe ProjectBranch) -> Cli ProjectBranch)
-> Cli ProjectBranch
forall a b. a -> (a -> b) -> b
& Cli ProjectBranch -> Cli (Maybe ProjectBranch) -> Cli ProjectBranch
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
        Output -> Cli ProjectBranch
forall a. Output -> Cli a
Cli.returnEarly (ProjectAndBranch ProjectName ProjectBranchName -> Output
LocalProjectBranchDoesntExist (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
branchName))
    pure (Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
project ProjectBranch
branch)
  These ProjectName
projectName ProjectBranchName
branchName -> do
    Maybe (ProjectAndBranch Project ProjectBranch)
maybeProjectAndBranch <-
      Transaction (Maybe (ProjectAndBranch Project ProjectBranch))
-> Cli (Maybe (ProjectAndBranch Project ProjectBranch))
forall a. Transaction a -> Cli a
Cli.runTransaction do
        MaybeT Transaction (ProjectAndBranch Project ProjectBranch)
-> Transaction (Maybe (ProjectAndBranch Project ProjectBranch))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
          Project
project <- Transaction (Maybe Project) -> MaybeT Transaction Project
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
projectName)
          ProjectBranch
branch <- Transaction (Maybe ProjectBranch)
-> MaybeT Transaction ProjectBranch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ProjectId -> ProjectBranchName -> Transaction (Maybe ProjectBranch)
Queries.loadProjectBranchByName (Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId) ProjectBranchName
branchName)
          pure (Project -> ProjectBranch -> ProjectAndBranch Project ProjectBranch
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
project ProjectBranch
branch)
    Maybe (ProjectAndBranch Project ProjectBranch)
maybeProjectAndBranch Maybe (ProjectAndBranch Project ProjectBranch)
-> (Maybe (ProjectAndBranch Project ProjectBranch)
    -> Cli (ProjectAndBranch Project ProjectBranch))
-> Cli (ProjectAndBranch Project ProjectBranch)
forall a b. a -> (a -> b) -> b
& Cli (ProjectAndBranch Project ProjectBranch)
-> Maybe (ProjectAndBranch Project ProjectBranch)
-> Cli (ProjectAndBranch Project ProjectBranch)
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing do
      Output -> Cli (ProjectAndBranch Project ProjectBranch)
forall a. Output -> Cli a
Cli.returnEarly (ProjectAndBranch ProjectName ProjectBranchName -> Output
LocalProjectBranchDoesntExist (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName))

-- | Expect/resolve branch reference with the following rules:
--
--   1. If the project is missing, use the provided project.
--   2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the provided
--      project, defaulting to 'main' if branch is unspecified.
resolveProjectBranchInProject :: Project -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
resolveProjectBranchInProject :: Project
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
resolveProjectBranchInProject Project
defaultProj (ProjectAndBranch Maybe ProjectName
mayProjectName Maybe ProjectBranchName
mayBranchName) = do
  let branchName :: ProjectBranchName
branchName = ProjectBranchName -> Maybe ProjectBranchName -> ProjectBranchName
forall a. a -> Maybe a -> a
fromMaybe (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"main") Maybe ProjectBranchName
mayBranchName
  let projectName :: ProjectName
projectName = ProjectName -> Maybe ProjectName -> ProjectName
forall a. a -> Maybe a -> a
fromMaybe (Project
defaultProj Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name) Maybe ProjectName
mayProjectName
  ProjectAndBranch Project ProjectBranch
projectAndBranch <- These ProjectName ProjectBranchName
-> Cli (ProjectAndBranch Project ProjectBranch)
expectProjectAndBranchByTheseNames (ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
projectName ProjectBranchName
branchName)
  pure ProjectAndBranch Project ProjectBranch
projectAndBranch

-- | Expect/resolve branch reference with the following rules:
--
--   1. If the project is missing, use the current project.
--   2. If we have an unambiguous `/branch` or `project/branch`, resolve it using the current
--      project, defaulting to 'main' if branch is unspecified.
resolveProjectBranch :: ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
resolveProjectBranch :: ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
resolveProjectBranch ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
pab = do
  ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
  Project
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
resolveProjectBranchInProject (ProjectPath
pp ProjectPath -> Getting Project ProjectPath Project -> Project
forall s a. s -> Getting a s a -> a
^. Getting Project ProjectPath Project
#project) ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
pab

-- | Get the causal hash of a project branch.
getProjectBranchCausalHash :: ProjectBranch -> Transaction CausalHash
getProjectBranchCausalHash :: ProjectBranch -> Transaction CausalHash
getProjectBranchCausalHash ProjectBranch {ProjectId
projectId :: ProjectId
$sel:projectId:ProjectBranch :: ProjectBranch -> ProjectId
projectId, ProjectBranchId
branchId :: ProjectBranchId
$sel:branchId:ProjectBranch :: ProjectBranch -> ProjectBranchId
branchId} = do
  CausalHashId
causalHashId <- HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Q.expectProjectBranchHead ProjectId
projectId ProjectBranchId
branchId
  CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
causalHashId

------------------------------------------------------------------------------------------------------------------------
-- Remote project utils

-- | Expect a remote project by id. Its latest-known name is also provided, for error messages.
expectRemoteProjectById :: RemoteProjectId -> ProjectName -> Cli Share.RemoteProject
expectRemoteProjectById :: RemoteProjectId -> ProjectName -> Cli RemoteProject
expectRemoteProjectById RemoteProjectId
remoteProjectId ProjectName
remoteProjectName = do
  RemoteProjectId -> Cli (Maybe RemoteProject)
Share.getProjectById RemoteProjectId
remoteProjectId Cli (Maybe RemoteProject)
-> (Cli (Maybe RemoteProject) -> Cli RemoteProject)
-> Cli RemoteProject
forall a b. a -> (a -> b) -> b
& Cli RemoteProject -> Cli (Maybe RemoteProject) -> Cli RemoteProject
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
    Output -> Cli RemoteProject
forall a. Output -> Cli a
Cli.returnEarly (URI -> ProjectName -> Output
Output.RemoteProjectDoesntExist URI
Share.hardCodedUri ProjectName
remoteProjectName)

expectRemoteProjectByName :: ProjectName -> Cli Share.RemoteProject
expectRemoteProjectByName :: ProjectName -> Cli RemoteProject
expectRemoteProjectByName ProjectName
remoteProjectName = do
  ProjectName -> Cli (Maybe RemoteProject)
Share.getProjectByName ProjectName
remoteProjectName Cli (Maybe RemoteProject)
-> (Cli (Maybe RemoteProject) -> Cli RemoteProject)
-> Cli RemoteProject
forall a b. a -> (a -> b) -> b
& Cli RemoteProject -> Cli (Maybe RemoteProject) -> Cli RemoteProject
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
    Output -> Cli RemoteProject
forall a. Output -> Cli a
Cli.returnEarly (URI -> ProjectName -> Output
Output.RemoteProjectDoesntExist URI
Share.hardCodedUri ProjectName
remoteProjectName)

expectRemoteProjectBranchById ::
  IncludeSquashedHead ->
  ProjectAndBranch (RemoteProjectId, ProjectName) (RemoteProjectBranchId, ProjectBranchName) ->
  Cli Share.RemoteProjectBranch
expectRemoteProjectBranchById :: IncludeSquashedHead
-> ProjectAndBranch
     (RemoteProjectId, ProjectName)
     (RemoteProjectBranchId, ProjectBranchName)
-> Cli RemoteProjectBranch
expectRemoteProjectBranchById IncludeSquashedHead
includeSquashed ProjectAndBranch
  (RemoteProjectId, ProjectName)
  (RemoteProjectBranchId, ProjectBranchName)
projectAndBranch = do
  IncludeSquashedHead
-> ProjectAndBranch RemoteProjectId RemoteProjectBranchId
-> Cli GetProjectBranchResponse
Share.getProjectBranchById IncludeSquashedHead
includeSquashed ProjectAndBranch RemoteProjectId RemoteProjectBranchId
projectAndBranchIds Cli GetProjectBranchResponse
-> (GetProjectBranchResponse -> Cli RemoteProjectBranch)
-> Cli RemoteProjectBranch
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    GetProjectBranchResponse
Share.GetProjectBranchResponseBranchNotFound -> ProjectAndBranch ProjectName ProjectBranchName
-> Cli RemoteProjectBranch
forall void.
ProjectAndBranch ProjectName ProjectBranchName -> Cli void
remoteProjectBranchDoesntExist ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchNames
    GetProjectBranchResponse
Share.GetProjectBranchResponseProjectNotFound -> ProjectAndBranch ProjectName ProjectBranchName
-> Cli RemoteProjectBranch
forall void.
ProjectAndBranch ProjectName ProjectBranchName -> Cli void
remoteProjectBranchDoesntExist ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchNames
    Share.GetProjectBranchResponseSuccess RemoteProjectBranch
branch -> RemoteProjectBranch -> Cli RemoteProjectBranch
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteProjectBranch
branch
  where
    projectAndBranchIds :: ProjectAndBranch RemoteProjectId RemoteProjectBranchId
projectAndBranchIds = ProjectAndBranch
  (RemoteProjectId, ProjectName)
  (RemoteProjectBranchId, ProjectBranchName)
projectAndBranch ProjectAndBranch
  (RemoteProjectId, ProjectName)
  (RemoteProjectBranchId, ProjectBranchName)
-> (ProjectAndBranch
      (RemoteProjectId, ProjectName)
      (RemoteProjectBranchId, ProjectBranchName)
    -> ProjectAndBranch
         RemoteProjectId (RemoteProjectBranchId, ProjectBranchName))
-> ProjectAndBranch
     RemoteProjectId (RemoteProjectBranchId, ProjectBranchName)
forall a b. a -> (a -> b) -> b
& ASetter
  (ProjectAndBranch
     (RemoteProjectId, ProjectName)
     (RemoteProjectBranchId, ProjectBranchName))
  (ProjectAndBranch
     RemoteProjectId (RemoteProjectBranchId, ProjectBranchName))
  (RemoteProjectId, ProjectName)
  RemoteProjectId
-> ((RemoteProjectId, ProjectName) -> RemoteProjectId)
-> ProjectAndBranch
     (RemoteProjectId, ProjectName)
     (RemoteProjectBranchId, ProjectBranchName)
-> ProjectAndBranch
     RemoteProjectId (RemoteProjectBranchId, ProjectBranchName)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectAndBranch
     (RemoteProjectId, ProjectName)
     (RemoteProjectBranchId, ProjectBranchName))
  (ProjectAndBranch
     RemoteProjectId (RemoteProjectBranchId, ProjectBranchName))
  (RemoteProjectId, ProjectName)
  RemoteProjectId
#project (RemoteProjectId, ProjectName) -> RemoteProjectId
forall a b. (a, b) -> a
fst ProjectAndBranch
  RemoteProjectId (RemoteProjectBranchId, ProjectBranchName)
-> (ProjectAndBranch
      RemoteProjectId (RemoteProjectBranchId, ProjectBranchName)
    -> ProjectAndBranch RemoteProjectId RemoteProjectBranchId)
-> ProjectAndBranch RemoteProjectId RemoteProjectBranchId
forall a b. a -> (a -> b) -> b
& ASetter
  (ProjectAndBranch
     RemoteProjectId (RemoteProjectBranchId, ProjectBranchName))
  (ProjectAndBranch RemoteProjectId RemoteProjectBranchId)
  (RemoteProjectBranchId, ProjectBranchName)
  RemoteProjectBranchId
-> ((RemoteProjectBranchId, ProjectBranchName)
    -> RemoteProjectBranchId)
-> ProjectAndBranch
     RemoteProjectId (RemoteProjectBranchId, ProjectBranchName)
-> ProjectAndBranch RemoteProjectId RemoteProjectBranchId
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectAndBranch
     RemoteProjectId (RemoteProjectBranchId, ProjectBranchName))
  (ProjectAndBranch RemoteProjectId RemoteProjectBranchId)
  (RemoteProjectBranchId, ProjectBranchName)
  RemoteProjectBranchId
#branch (RemoteProjectBranchId, ProjectBranchName) -> RemoteProjectBranchId
forall a b. (a, b) -> a
fst
    projectAndBranchNames :: ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchNames = ProjectAndBranch
  (RemoteProjectId, ProjectName)
  (RemoteProjectBranchId, ProjectBranchName)
projectAndBranch ProjectAndBranch
  (RemoteProjectId, ProjectName)
  (RemoteProjectBranchId, ProjectBranchName)
-> (ProjectAndBranch
      (RemoteProjectId, ProjectName)
      (RemoteProjectBranchId, ProjectBranchName)
    -> ProjectAndBranch
         ProjectName (RemoteProjectBranchId, ProjectBranchName))
-> ProjectAndBranch
     ProjectName (RemoteProjectBranchId, ProjectBranchName)
forall a b. a -> (a -> b) -> b
& ASetter
  (ProjectAndBranch
     (RemoteProjectId, ProjectName)
     (RemoteProjectBranchId, ProjectBranchName))
  (ProjectAndBranch
     ProjectName (RemoteProjectBranchId, ProjectBranchName))
  (RemoteProjectId, ProjectName)
  ProjectName
-> ((RemoteProjectId, ProjectName) -> ProjectName)
-> ProjectAndBranch
     (RemoteProjectId, ProjectName)
     (RemoteProjectBranchId, ProjectBranchName)
-> ProjectAndBranch
     ProjectName (RemoteProjectBranchId, ProjectBranchName)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectAndBranch
     (RemoteProjectId, ProjectName)
     (RemoteProjectBranchId, ProjectBranchName))
  (ProjectAndBranch
     ProjectName (RemoteProjectBranchId, ProjectBranchName))
  (RemoteProjectId, ProjectName)
  ProjectName
#project (RemoteProjectId, ProjectName) -> ProjectName
forall a b. (a, b) -> b
snd ProjectAndBranch
  ProjectName (RemoteProjectBranchId, ProjectBranchName)
-> (ProjectAndBranch
      ProjectName (RemoteProjectBranchId, ProjectBranchName)
    -> ProjectAndBranch ProjectName ProjectBranchName)
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> (a -> b) -> b
& ASetter
  (ProjectAndBranch
     ProjectName (RemoteProjectBranchId, ProjectBranchName))
  (ProjectAndBranch ProjectName ProjectBranchName)
  (RemoteProjectBranchId, ProjectBranchName)
  ProjectBranchName
-> ((RemoteProjectBranchId, ProjectBranchName)
    -> ProjectBranchName)
-> ProjectAndBranch
     ProjectName (RemoteProjectBranchId, ProjectBranchName)
-> ProjectAndBranch ProjectName ProjectBranchName
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectAndBranch
     ProjectName (RemoteProjectBranchId, ProjectBranchName))
  (ProjectAndBranch ProjectName ProjectBranchName)
  (RemoteProjectBranchId, ProjectBranchName)
  ProjectBranchName
#branch (RemoteProjectBranchId, ProjectBranchName) -> ProjectBranchName
forall a b. (a, b) -> b
snd

loadRemoteProjectBranchByName ::
  IncludeSquashedHead ->
  ProjectAndBranch RemoteProjectId ProjectBranchName ->
  Cli (Maybe Share.RemoteProjectBranch)
loadRemoteProjectBranchByName :: IncludeSquashedHead
-> ProjectAndBranch RemoteProjectId ProjectBranchName
-> Cli (Maybe RemoteProjectBranch)
loadRemoteProjectBranchByName IncludeSquashedHead
includeSquashed ProjectAndBranch RemoteProjectId ProjectBranchName
projectAndBranch =
  IncludeSquashedHead
-> ProjectAndBranch RemoteProjectId ProjectBranchName
-> Cli GetProjectBranchResponse
Share.getProjectBranchByName IncludeSquashedHead
includeSquashed ProjectAndBranch RemoteProjectId ProjectBranchName
projectAndBranch 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
branch -> RemoteProjectBranch -> Maybe RemoteProjectBranch
forall a. a -> Maybe a
Just RemoteProjectBranch
branch

expectRemoteProjectBranchByName ::
  IncludeSquashedHead ->
  ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName ->
  Cli Share.RemoteProjectBranch
expectRemoteProjectBranchByName :: IncludeSquashedHead
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
-> Cli RemoteProjectBranch
expectRemoteProjectBranchByName IncludeSquashedHead
includeSquashed ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName
projectAndBranch =
  IncludeSquashedHead
-> ProjectAndBranch RemoteProjectId ProjectBranchName
-> Cli GetProjectBranchResponse
Share.getProjectBranchByName IncludeSquashedHead
includeSquashed (ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName
projectAndBranch ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName
-> (ProjectAndBranch
      (RemoteProjectId, ProjectName) ProjectBranchName
    -> ProjectAndBranch RemoteProjectId ProjectBranchName)
-> ProjectAndBranch RemoteProjectId ProjectBranchName
forall a b. a -> (a -> b) -> b
& ASetter
  (ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName)
  (ProjectAndBranch RemoteProjectId ProjectBranchName)
  (RemoteProjectId, ProjectName)
  RemoteProjectId
-> ((RemoteProjectId, ProjectName) -> RemoteProjectId)
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
-> ProjectAndBranch RemoteProjectId ProjectBranchName
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName)
  (ProjectAndBranch RemoteProjectId ProjectBranchName)
  (RemoteProjectId, ProjectName)
  RemoteProjectId
#project (RemoteProjectId, ProjectName) -> RemoteProjectId
forall a b. (a, b) -> a
fst) Cli GetProjectBranchResponse
-> (GetProjectBranchResponse -> Cli RemoteProjectBranch)
-> Cli RemoteProjectBranch
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    GetProjectBranchResponse
Share.GetProjectBranchResponseBranchNotFound -> Cli RemoteProjectBranch
doesntExist
    GetProjectBranchResponse
Share.GetProjectBranchResponseProjectNotFound -> Cli RemoteProjectBranch
doesntExist
    Share.GetProjectBranchResponseSuccess RemoteProjectBranch
branch -> RemoteProjectBranch -> Cli RemoteProjectBranch
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteProjectBranch
branch
  where
    doesntExist :: Cli RemoteProjectBranch
doesntExist =
      ProjectAndBranch ProjectName ProjectBranchName
-> Cli RemoteProjectBranch
forall void.
ProjectAndBranch ProjectName ProjectBranchName -> Cli void
remoteProjectBranchDoesntExist (ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName
projectAndBranch ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName
-> (ProjectAndBranch
      (RemoteProjectId, ProjectName) ProjectBranchName
    -> ProjectAndBranch ProjectName ProjectBranchName)
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> (a -> b) -> b
& ASetter
  (ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName)
  (ProjectAndBranch ProjectName ProjectBranchName)
  (RemoteProjectId, ProjectName)
  ProjectName
-> ((RemoteProjectId, ProjectName) -> ProjectName)
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectAndBranch (RemoteProjectId, ProjectName) ProjectBranchName)
  (ProjectAndBranch ProjectName ProjectBranchName)
  (RemoteProjectId, ProjectName)
  ProjectName
#project (RemoteProjectId, ProjectName) -> ProjectName
forall a b. (a, b) -> b
snd)

loadRemoteProjectBranchByNames ::
  IncludeSquashedHead ->
  ProjectAndBranch ProjectName ProjectBranchName ->
  Cli (Maybe Share.RemoteProjectBranch)
loadRemoteProjectBranchByNames :: IncludeSquashedHead
-> ProjectAndBranch ProjectName ProjectBranchName
-> Cli (Maybe RemoteProjectBranch)
loadRemoteProjectBranchByNames IncludeSquashedHead
includeSquashed (ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName) =
  MaybeT Cli RemoteProjectBranch -> Cli (Maybe RemoteProjectBranch)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    RemoteProject
project <- Cli (Maybe RemoteProject) -> MaybeT Cli RemoteProject
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ProjectName -> Cli (Maybe RemoteProject)
Share.getProjectByName ProjectName
projectName)
    Cli (Maybe RemoteProjectBranch) -> MaybeT Cli RemoteProjectBranch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IncludeSquashedHead
-> ProjectAndBranch RemoteProjectId ProjectBranchName
-> Cli (Maybe RemoteProjectBranch)
loadRemoteProjectBranchByName IncludeSquashedHead
includeSquashed (RemoteProjectId
-> ProjectBranchName
-> ProjectAndBranch RemoteProjectId ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (RemoteProject
project RemoteProject
-> Getting RemoteProjectId RemoteProject RemoteProjectId
-> RemoteProjectId
forall s a. s -> Getting a s a -> a
^. Getting RemoteProjectId RemoteProject RemoteProjectId
#projectId) ProjectBranchName
branchName))

expectRemoteProjectBranchByNames ::
  IncludeSquashedHead ->
  ProjectAndBranch ProjectName ProjectBranchName ->
  Cli Share.RemoteProjectBranch
expectRemoteProjectBranchByNames :: IncludeSquashedHead
-> ProjectAndBranch ProjectName ProjectBranchName
-> Cli RemoteProjectBranch
expectRemoteProjectBranchByNames IncludeSquashedHead
includeSquashed (ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName) = do
  RemoteProject
project <- ProjectName -> Cli RemoteProject
expectRemoteProjectByName ProjectName
projectName
  IncludeSquashedHead
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
-> Cli RemoteProjectBranch
expectRemoteProjectBranchByName IncludeSquashedHead
includeSquashed ((RemoteProjectId, ProjectName)
-> ProjectBranchName
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (RemoteProject
project RemoteProject
-> Getting RemoteProjectId RemoteProject RemoteProjectId
-> RemoteProjectId
forall s a. s -> Getting a s a -> a
^. Getting RemoteProjectId RemoteProject RemoteProjectId
#projectId, RemoteProject
project RemoteProject
-> Getting ProjectName RemoteProject ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName RemoteProject ProjectName
#projectName) ProjectBranchName
branchName)

-- Expect a remote project branch by a "these names".
--
--   If both names are provided, use them.
--
--   If only a project name is provided, use branch name "main".
--
--   If only a branch name is provided, use the current branch's remote mapping (falling back to its parent, etc) to get
--   the project.
expectRemoteProjectBranchByTheseNames :: IncludeSquashedHead -> These ProjectName ProjectBranchName -> Cli Share.RemoteProjectBranch
expectRemoteProjectBranchByTheseNames :: IncludeSquashedHead
-> These ProjectName ProjectBranchName -> Cli RemoteProjectBranch
expectRemoteProjectBranchByTheseNames IncludeSquashedHead
includeSquashed = \case
  This ProjectName
remoteProjectName -> do
    RemoteProject
remoteProject <- ProjectName -> Cli RemoteProject
expectRemoteProjectByName ProjectName
remoteProjectName
    let remoteProjectId :: RemoteProjectId
remoteProjectId = RemoteProject
remoteProject RemoteProject
-> Getting RemoteProjectId RemoteProject RemoteProjectId
-> RemoteProjectId
forall s a. s -> Getting a s a -> a
^. Getting RemoteProjectId RemoteProject RemoteProjectId
#projectId
    let remoteBranchName :: ProjectBranchName
remoteBranchName = forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"main"
    IncludeSquashedHead
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
-> Cli RemoteProjectBranch
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)
  That ProjectBranchName
branchName -> do
    PP.ProjectPath Project
localProject ProjectBranch
localBranch Absolute
_restPath <- Cli ProjectPath
Cli.getCurrentProjectPath
    let localProjectId :: ProjectId
localProjectId = Project
localProject Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId
    let localBranchId :: ProjectBranchId
localBranchId = ProjectBranch
localBranch ProjectBranch
-> Getting ProjectBranchId ProjectBranch ProjectBranchId
-> ProjectBranchId
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranchId ProjectBranch ProjectBranchId
#branchId
    Transaction (Maybe (RemoteProjectId, Maybe RemoteProjectBranchId))
-> Cli (Maybe (RemoteProjectId, Maybe RemoteProjectBranchId))
forall a. Transaction a -> Cli a
Cli.runTransaction (ProjectId
-> URI
-> ProjectBranchId
-> Transaction
     (Maybe (RemoteProjectId, Maybe RemoteProjectBranchId))
Queries.loadRemoteProjectBranch ProjectId
localProjectId URI
Share.hardCodedUri ProjectBranchId
localBranchId) Cli (Maybe (RemoteProjectId, Maybe RemoteProjectBranchId))
-> (Maybe (RemoteProjectId, Maybe RemoteProjectBranchId)
    -> Cli RemoteProjectBranch)
-> Cli RemoteProjectBranch
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just (RemoteProjectId
remoteProjectId, Maybe RemoteProjectBranchId
_maybeProjectBranchId) -> 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
expectRemoteProjectBranchByName IncludeSquashedHead
includeSquashed ((RemoteProjectId, ProjectName)
-> ProjectBranchName
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (RemoteProjectId
remoteProjectId, ProjectName
remoteProjectName) ProjectBranchName
branchName)
      Maybe (RemoteProjectId, Maybe RemoteProjectBranchId)
Nothing -> do
        Output -> Cli RemoteProjectBranch
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli RemoteProjectBranch)
-> Output -> Cli RemoteProjectBranch
forall a b. (a -> b) -> a -> b
$
          URI -> ProjectAndBranch ProjectName ProjectBranchName -> Output
Output.NoAssociatedRemoteProject
            URI
Share.hardCodedUri
            (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (Project
localProject Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name) (ProjectBranch
localBranch ProjectBranch
-> Getting ProjectBranchName ProjectBranch ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranchName ProjectBranch ProjectBranchName
#name))
  These ProjectName
projectName ProjectBranchName
branchName -> do
    RemoteProject
remoteProject <- ProjectName -> Cli RemoteProject
expectRemoteProjectByName ProjectName
projectName
    let remoteProjectId :: RemoteProjectId
remoteProjectId = RemoteProject
remoteProject RemoteProject
-> Getting RemoteProjectId RemoteProject RemoteProjectId
-> RemoteProjectId
forall s a. s -> Getting a s a -> a
^. Getting RemoteProjectId RemoteProject RemoteProjectId
#projectId
    IncludeSquashedHead
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
-> Cli RemoteProjectBranch
expectRemoteProjectBranchByName IncludeSquashedHead
includeSquashed ((RemoteProjectId, ProjectName)
-> ProjectBranchName
-> ProjectAndBranch
     (RemoteProjectId, ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (RemoteProjectId
remoteProjectId, ProjectName
projectName) ProjectBranchName
branchName)

remoteProjectBranchDoesntExist :: ProjectAndBranch ProjectName ProjectBranchName -> Cli void
remoteProjectBranchDoesntExist :: forall void.
ProjectAndBranch ProjectName ProjectBranchName -> Cli void
remoteProjectBranchDoesntExist ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch =
  Output -> Cli void
forall a. Output -> Cli a
Cli.returnEarly (URI -> ProjectAndBranch ProjectName ProjectBranchName -> Output
Output.RemoteProjectBranchDoesntExist URI
Share.hardCodedUri ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch)

-- | Expect the given remote project to have a latest release, and return it as a valid branch name.
expectLatestReleaseBranchName :: Share.RemoteProject -> Cli ProjectBranchName
expectLatestReleaseBranchName :: RemoteProject -> Cli ProjectBranchName
expectLatestReleaseBranchName RemoteProject
remoteProject =
  case RemoteProject
remoteProject.latestRelease of
    Maybe Semver
Nothing -> Output -> Cli ProjectBranchName
forall a. Output -> Cli a
Cli.returnEarly (ProjectName -> Output
Output.ProjectHasNoReleases RemoteProject
remoteProject.projectName)
    Just Semver
semver -> ProjectBranchName -> Cli ProjectBranchName
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ProjectBranchName
UnsafeProjectBranchName (Text
"releases/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text Semver
semver))

-- | @getMergeBranchParent branch@ returns the parent branch of a "merge" branch.
--
-- When a merge fails, we put you on a branch called `merge-<source>-into-<target>`. That's a "merge" branch. It's not
-- currently distinguished in the database, so we first just switch on whether its name begins with "merge-". If it
-- does, then we get the branch's parent, which should exist, but perhaps wouldn't if the user had manually made a
-- parentless branch called "merge-whatever" for whatever reason.
getMergeBranchParent :: Sqlite.ProjectBranch -> Maybe ProjectBranchId
getMergeBranchParent :: ProjectBranch -> Maybe ProjectBranchId
getMergeBranchParent ProjectBranch
branch = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
"merge-" Text -> Text -> Bool
`Text.isPrefixOf` forall target source. From source target => source -> target
into @Text ProjectBranch
branch.name)
  ProjectBranch
branch.parentBranchId

-- | @getUpgradeBranchParent branch@ returns the parent branch of an "upgrade" branch.
--
-- When an upgrade fails, we put you on a branch called `upgrade-<old>-to-<new>`. That's an "upgrade" branch. It's not
-- currently distinguished in the database, so we first just switch on whether its name begins with "upgrade-". If it
-- does, then we get the branch's parent, which should exist, but perhaps wouldn't if the user had manually made a
-- parentless branch called "upgrade-whatever" for whatever reason.
getUpgradeBranchParent :: Sqlite.ProjectBranch -> Maybe ProjectBranchId
getUpgradeBranchParent :: ProjectBranch -> Maybe ProjectBranchId
getUpgradeBranchParent ProjectBranch
branch = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
"upgrade-" Text -> Text -> Bool
`Text.isPrefixOf` forall target source. From source target => source -> target
into @Text ProjectBranch
branch.name)
  ProjectBranch
branch.parentBranchId