mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-26 11:07:48 +03:00
add lib.install
command
This commit is contained in:
parent
4bd924a0c9
commit
30294bb452
@ -45,19 +45,18 @@ import Unison.Sync.Types qualified as Share
|
||||
-- | Download a project/branch from Share.
|
||||
downloadProjectBranchFromShare ::
|
||||
HasCallStack =>
|
||||
Bool ->
|
||||
Share.IncludeSquashedHead ->
|
||||
Share.RemoteProjectBranch ->
|
||||
Cli (Either Output.ShareError CausalHash)
|
||||
downloadProjectBranchFromShare useSquashedIfAvailable branch =
|
||||
downloadProjectBranchFromShare useSquashed branch =
|
||||
Cli.labelE \done -> do
|
||||
let remoteProjectBranchName = branch.branchName
|
||||
let repoInfo = Share.RepoInfo (into @Text (ProjectAndBranch branch.projectName remoteProjectBranchName))
|
||||
causalHashJwt <-
|
||||
if useSquashedIfAvailable
|
||||
then case branch.squashedBranchHead of
|
||||
Nothing -> done Output.ShareExpectedSquashedHead
|
||||
Just squashedHead -> pure squashedHead
|
||||
else pure branch.branchHead
|
||||
case (useSquashed, branch.squashedBranchHead) of
|
||||
(Share.IncludeSquashedHead, Nothing) -> done Output.ShareExpectedSquashedHead
|
||||
(Share.IncludeSquashedHead, Just squashedHead) -> pure squashedHead
|
||||
(Share.NoSquashedHead, _) -> pure branch.branchHead
|
||||
exists <- Cli.runTransaction (Queries.causalExistsByHash32 (Share.hashJWTHash causalHashJwt))
|
||||
when (not exists) do
|
||||
(result, numDownloaded) <-
|
||||
|
@ -26,6 +26,7 @@ module Unison.Cli.ProjectUtils
|
||||
expectLooseCodeOrProjectBranch,
|
||||
|
||||
-- * Loading remote project info
|
||||
expectRemoteProjectById,
|
||||
expectRemoteProjectByName,
|
||||
expectRemoteProjectBranchById,
|
||||
loadRemoteProjectBranchByName,
|
||||
@ -33,6 +34,7 @@ module Unison.Cli.ProjectUtils
|
||||
loadRemoteProjectBranchByNames,
|
||||
expectRemoteProjectBranchByNames,
|
||||
expectRemoteProjectBranchByTheseNames,
|
||||
expectLatestReleaseBranchName,
|
||||
)
|
||||
where
|
||||
|
||||
@ -54,8 +56,9 @@ import Unison.Codebase.Path (Path')
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.CommandLine.BranchRelativePath (BranchRelativePath, ResolvedBranchRelativePath)
|
||||
import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath
|
||||
import Unison.Core.Project (ProjectBranchName (..))
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectName)
|
||||
import Unison.Project.Util
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Witch (unsafeFrom)
|
||||
@ -230,6 +233,12 @@ expectLooseCodeOrProjectBranch =
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- 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 remoteProjectName = do
|
||||
Share.getProjectById remoteProjectId & onNothingM do
|
||||
Cli.returnEarly (Output.RemoteProjectDoesntExist Share.hardCodedUri remoteProjectName)
|
||||
|
||||
expectRemoteProjectByName :: ProjectName -> Cli Share.RemoteProject
|
||||
expectRemoteProjectByName remoteProjectName = do
|
||||
Share.getProjectByName remoteProjectName & onNothingM do
|
||||
@ -324,3 +333,10 @@ expectRemoteProjectBranchByTheseNames includeSquashed = \case
|
||||
remoteProjectBranchDoesntExist :: ProjectAndBranch ProjectName ProjectBranchName -> Cli void
|
||||
remoteProjectBranchDoesntExist projectAndBranch =
|
||||
Cli.returnEarly (Output.RemoteProjectBranchDoesntExist Share.hardCodedUri 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 =
|
||||
case remoteProject.latestRelease of
|
||||
Nothing -> Cli.returnEarly (Output.ProjectHasNoReleases remoteProject.projectName)
|
||||
Just semver -> pure (UnsafeProjectBranchName ("releases/" <> into @Text semver))
|
||||
|
@ -96,7 +96,7 @@ data GetProjectBranchResponse
|
||||
data IncludeSquashedHead
|
||||
= IncludeSquashedHead
|
||||
| NoSquashedHead
|
||||
deriving (Show, Eq)
|
||||
deriving stock (Show, Eq)
|
||||
|
||||
-- | Get a project branch by id.
|
||||
--
|
||||
|
@ -64,6 +64,7 @@ import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject)
|
||||
import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
|
||||
import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI)
|
||||
import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format
|
||||
import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib)
|
||||
import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile)
|
||||
import Unison.Codebase.Editor.HandleInput.MoveAll (handleMoveAll)
|
||||
import Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch)
|
||||
@ -1186,6 +1187,7 @@ loop e = do
|
||||
CloneI remoteNames localNames -> handleClone remoteNames localNames
|
||||
ReleaseDraftI semver -> handleReleaseDraft semver
|
||||
UpgradeI old new -> handleUpgrade old new
|
||||
LibInstallI libdep -> handleInstallLib libdep
|
||||
|
||||
inputDescription :: Input -> Cli Text
|
||||
inputDescription input =
|
||||
@ -1370,6 +1372,7 @@ inputDescription input =
|
||||
StructuredFindReplaceI {} -> wat
|
||||
GistI {} -> wat
|
||||
HistoryI {} -> wat
|
||||
LibInstallI {} -> wat
|
||||
ListDependenciesI {} -> wat
|
||||
ListDependentsI {} -> wat
|
||||
ListEditsI {} -> wat
|
||||
|
141
unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs
Normal file
141
unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs
Normal file
@ -0,0 +1,141 @@
|
||||
-- | @lib.install@ input handler
|
||||
module Unison.Codebase.Editor.HandleInput.InstallLib
|
||||
( handleInstallLib,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Reader (ask)
|
||||
import Data.List qualified as List
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Set qualified as Set
|
||||
import Data.Text qualified as Text
|
||||
import U.Codebase.Sqlite.Project qualified as Sqlite (Project (..))
|
||||
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch (..))
|
||||
import Unison.Cli.DownloadUtils
|
||||
import Unison.Cli.Monad (Cli)
|
||||
import Unison.Cli.Monad qualified as Cli
|
||||
import Unison.Cli.MonadUtils qualified as Cli
|
||||
import Unison.Cli.ProjectUtils qualified as ProjectUtils
|
||||
import Unison.Cli.Share.Projects qualified as Share
|
||||
import Unison.Codebase qualified as Codebase
|
||||
import Unison.Codebase.Branch qualified as Branch
|
||||
import Unison.Codebase.Editor.Output qualified as Output
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Core.Project (ProjectBranchName)
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Project
|
||||
( ProjectAndBranch (..),
|
||||
ProjectBranchNameKind (..),
|
||||
ProjectBranchNameOrLatestRelease (..),
|
||||
ProjectName,
|
||||
Semver (..),
|
||||
classifyProjectBranchName,
|
||||
projectNameToUserProjectSlugs,
|
||||
)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (unsafeParseText)
|
||||
|
||||
handleInstallLib :: ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease) -> Cli ()
|
||||
handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) = do
|
||||
(currentProjectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch
|
||||
|
||||
let currentProjectBranchPath =
|
||||
ProjectUtils.projectBranchPath $
|
||||
ProjectAndBranch
|
||||
currentProjectAndBranch.project.projectId
|
||||
currentProjectAndBranch.branch.branchId
|
||||
|
||||
libdepProject <- ProjectUtils.expectRemoteProjectByName libdepProjectName
|
||||
|
||||
libdepBranchName <-
|
||||
case fromMaybe ProjectBranchNameOrLatestRelease'LatestRelease unresolvedLibdepBranchName of
|
||||
ProjectBranchNameOrLatestRelease'Name name -> pure name
|
||||
ProjectBranchNameOrLatestRelease'LatestRelease -> ProjectUtils.expectLatestReleaseBranchName libdepProject
|
||||
|
||||
let libdepProjectAndBranchNames =
|
||||
ProjectAndBranch libdepProjectName libdepBranchName
|
||||
|
||||
libdepProjectBranch <-
|
||||
ProjectUtils.expectRemoteProjectBranchByName
|
||||
Share.IncludeSquashedHead
|
||||
(ProjectAndBranch (libdepProject.projectId, libdepProjectName) libdepBranchName)
|
||||
|
||||
Cli.Env {codebase} <- ask
|
||||
|
||||
causalHash <-
|
||||
downloadProjectBranchFromShare Share.IncludeSquashedHead libdepProjectBranch
|
||||
& onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
|
||||
remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase causalHash)
|
||||
|
||||
-- Find the best available dependency name, starting with the best one (e.g. "unison_base_1_0_0"), and tacking on a
|
||||
-- "__2", "__3", etc. suffix.
|
||||
--
|
||||
-- For example, if the best name is "foo", and libdeps "foo" and "foo__2" already exist, then we'll get "foo__3".
|
||||
libdepNameSegment :: NameSegment <- do
|
||||
currentBranchObject <- Cli.getBranch0At currentProjectBranchPath
|
||||
pure $
|
||||
fresh
|
||||
(\i -> NameSegment.unsafeParseText . (<> "__" <> tShow i) . NameSegment.toUnescapedText)
|
||||
( case Map.lookup NameSegment.libSegment currentBranchObject._children of
|
||||
Nothing -> Set.empty
|
||||
Just libdeps -> Map.keysSet (Branch._children (Branch.head libdeps))
|
||||
)
|
||||
(makeDependencyName libdepProjectName libdepBranchName)
|
||||
|
||||
let libdepPath :: Path.Absolute
|
||||
libdepPath =
|
||||
Path.resolve
|
||||
currentProjectBranchPath
|
||||
(Path.Relative (Path.fromList [NameSegment.libSegment, libdepNameSegment]))
|
||||
|
||||
let reflogDescription = "lib.install " <> into @Text libdepProjectAndBranchNames
|
||||
_didUpdate <- Cli.updateAt reflogDescription libdepPath (\_empty -> remoteBranchObject)
|
||||
|
||||
Cli.respond (Output.InstalledLibdep libdepProjectAndBranchNames libdepNameSegment)
|
||||
|
||||
fresh :: Ord a => (Int -> a -> a) -> Set a -> a -> a
|
||||
fresh bump taken x =
|
||||
fromJust (List.find (\y -> not (Set.member y taken)) (x : map (\i -> bump i x) [2 ..]))
|
||||
|
||||
-- This function mangles the dependency (a project name + a branch name) to a flat string without special characters,
|
||||
-- suitable for sticking in the `lib` namespace.
|
||||
--
|
||||
-- >>> makeDependencyName (unsafeFrom @Text "@unison/base") (unsafeFrom @Text "main")
|
||||
-- unison_base_main
|
||||
--
|
||||
-- >>> makeDependencyName (unsafeFrom @Text "@unison/base") (unsafeFrom @Text "releases/1.0.0")
|
||||
-- unison_base_1_0_0
|
||||
--
|
||||
-- >>> makeDependencyName (unsafeFrom @Text "@unison/base") (unsafeFrom @Text "releases/drafts/1.0.0")
|
||||
-- unison_base_1_0_0_draft
|
||||
--
|
||||
-- >>> makeDependencyName (unsafeFrom @Text "@unison/base") (unsafeFrom @Text "@person/topic")
|
||||
-- unison_base_person_topic
|
||||
makeDependencyName :: ProjectName -> ProjectBranchName -> NameSegment
|
||||
makeDependencyName projectName branchName =
|
||||
NameSegment.unsafeParseText $
|
||||
Text.intercalate "_" $
|
||||
fold
|
||||
[ case projectNameToUserProjectSlugs projectName of
|
||||
(user, project) ->
|
||||
fold
|
||||
[ if Text.null user then [] else [user],
|
||||
[project]
|
||||
],
|
||||
case classifyProjectBranchName branchName of
|
||||
ProjectBranchNameKind'Contributor user branch -> [user, underscorify branch]
|
||||
ProjectBranchNameKind'DraftRelease ver -> semverSegments ver ++ ["draft"]
|
||||
ProjectBranchNameKind'Release ver -> semverSegments ver
|
||||
ProjectBranchNameKind'NothingSpecial -> [underscorify branchName]
|
||||
]
|
||||
where
|
||||
semverSegments :: Semver -> [Text]
|
||||
semverSegments (Semver x y z) =
|
||||
[tShow x, tShow y, tShow z]
|
||||
|
||||
underscorify :: ProjectBranchName -> Text
|
||||
underscorify =
|
||||
Text.replace "-" "_" . into @Text
|
@ -10,7 +10,7 @@ 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.Project qualified as Sqlite (Project (..))
|
||||
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
|
||||
import U.Codebase.Sqlite.Queries qualified as Queries
|
||||
import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare)
|
||||
@ -42,7 +42,7 @@ handleClone remoteNames0 maybeLocalNames0 = do
|
||||
maybeCurrentProjectBranch <- ProjectUtils.getCurrentProjectBranch
|
||||
resolvedRemoteNames <- resolveRemoteNames Share.NoSquashedHead maybeCurrentProjectBranch remoteNames0
|
||||
localNames1 <- resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames0
|
||||
cloneInto localNames1 (resolvedRemoteNames ^. #branch)
|
||||
cloneInto localNames1 resolvedRemoteNames.branch
|
||||
|
||||
data ResolvedRemoteNames = ResolvedRemoteNames
|
||||
{ branch :: Share.RemoteProjectBranch,
|
||||
@ -101,8 +101,8 @@ resolveRemoteNames includeSquashed maybeCurrentProjectBranch = \case
|
||||
Share.GetProjectBranchResponseSuccess remoteBranch -> Just remoteBranch
|
||||
case (maybeRemoteProject, maybeRemoteBranch) of
|
||||
(Just remoteProject, Nothing) -> do
|
||||
let remoteProjectId = remoteProject ^. #projectId
|
||||
let remoteProjectName = remoteProject ^. #projectName
|
||||
let remoteProjectId = remoteProject.projectId
|
||||
let remoteProjectName = remoteProject.projectName
|
||||
let remoteBranchName = unsafeFrom @Text "main"
|
||||
remoteBranch <-
|
||||
ProjectUtils.expectRemoteProjectBranchByName
|
||||
@ -188,14 +188,14 @@ resolveLocalNames ::
|
||||
resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames =
|
||||
resolve case maybeLocalNames of
|
||||
Nothing ->
|
||||
ProjectAndBranchNames'Unambiguous case resolvedRemoteNames ^. #from of
|
||||
ProjectAndBranchNames'Unambiguous case resolvedRemoteNames.from of
|
||||
ResolvedRemoteNamesFrom'Branch -> That remoteBranchName
|
||||
ResolvedRemoteNamesFrom'Project -> This remoteProjectName
|
||||
ResolvedRemoteNamesFrom'ProjectAndBranch -> These remoteProjectName remoteBranchName
|
||||
Just localNames -> localNames
|
||||
where
|
||||
remoteBranchName = resolvedRemoteNames ^. #branch ^. #branchName
|
||||
remoteProjectName = resolvedRemoteNames ^. #branch ^. #projectName
|
||||
remoteBranchName = resolvedRemoteNames.branch.branchName
|
||||
remoteProjectName = resolvedRemoteNames.branch.projectName
|
||||
|
||||
resolve names =
|
||||
case names of
|
||||
@ -206,7 +206,7 @@ resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames
|
||||
Cli.returnEarly $
|
||||
Output.AmbiguousCloneLocal
|
||||
(ProjectAndBranch localProjectName remoteBranchName)
|
||||
(ProjectAndBranch (currentProject ^. #name) localBranchName)
|
||||
(ProjectAndBranch currentProject.name localBranchName)
|
||||
ProjectAndBranchNames'Unambiguous (This localProjectName) -> resolveP localProjectName
|
||||
ProjectAndBranchNames'Unambiguous (That localBranchName) -> resolveB localBranchName
|
||||
ProjectAndBranchNames'Unambiguous (These localProjectName localBranchName) -> resolvePB localProjectName localBranchName
|
||||
@ -232,12 +232,12 @@ resolveLocalNames maybeCurrentProjectBranch resolvedRemoteNames maybeLocalNames
|
||||
-- it takes some time to pull the remote).
|
||||
cloneInto :: ProjectAndBranch LocalProjectKey ProjectBranchName -> Share.RemoteProjectBranch -> Cli ()
|
||||
cloneInto localProjectBranch remoteProjectBranch = do
|
||||
let remoteProjectName = remoteProjectBranch ^. #projectName
|
||||
let remoteBranchName = remoteProjectBranch ^. #branchName
|
||||
let remoteProjectName = remoteProjectBranch.projectName
|
||||
let remoteBranchName = remoteProjectBranch.branchName
|
||||
let remoteProjectBranchNames = ProjectAndBranch remoteProjectName remoteBranchName
|
||||
|
||||
branchHead <-
|
||||
downloadProjectBranchFromShare False {- use squashed -} remoteProjectBranch
|
||||
downloadProjectBranchFromShare Share.NoSquashedHead remoteProjectBranch
|
||||
& onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
|
||||
localProjectAndBranch <-
|
||||
@ -252,21 +252,21 @@ cloneInto localProjectBranch remoteProjectBranch = do
|
||||
localProjectId <- Sqlite.unsafeIO (ProjectId <$> UUID.nextRandom)
|
||||
Queries.insertProject localProjectId localProjectName
|
||||
pure (localProjectId, localProjectName)
|
||||
Right localProject -> pure (localProject ^. #projectId, localProject ^. #name)
|
||||
Right localProject -> pure (localProject.projectId, localProject.name)
|
||||
localBranchId <- Sqlite.unsafeIO (ProjectBranchId <$> UUID.nextRandom)
|
||||
Queries.insertProjectBranch
|
||||
Sqlite.ProjectBranch
|
||||
{ projectId = localProjectId,
|
||||
branchId = localBranchId,
|
||||
name = localProjectBranch ^. #branch,
|
||||
name = localProjectBranch.branch,
|
||||
parentBranchId = Nothing
|
||||
}
|
||||
Queries.insertBranchRemoteMapping
|
||||
localProjectId
|
||||
localBranchId
|
||||
(remoteProjectBranch ^. #projectId)
|
||||
remoteProjectBranch.projectId
|
||||
Share.hardCodedUri
|
||||
(remoteProjectBranch ^. #branchId)
|
||||
remoteProjectBranch.branchId
|
||||
pure (ProjectAndBranch (localProjectId, localProjectName) localBranchId)
|
||||
|
||||
Cli.respond $
|
||||
@ -274,7 +274,7 @@ cloneInto localProjectBranch remoteProjectBranch = do
|
||||
remoteProjectBranchNames
|
||||
( ProjectAndBranch
|
||||
(localProjectAndBranch ^. #project . _2)
|
||||
(localProjectBranch ^. #branch)
|
||||
localProjectBranch.branch
|
||||
)
|
||||
|
||||
-- Manipulate the root namespace and cd
|
||||
@ -291,8 +291,8 @@ loadAssociatedRemoteProjectId ::
|
||||
loadAssociatedRemoteProjectId (ProjectAndBranch project branch) =
|
||||
fmap fst <$> Queries.loadRemoteProjectBranch projectId Share.hardCodedUri branchId
|
||||
where
|
||||
projectId = project ^. #projectId
|
||||
branchId = branch ^. #branchId
|
||||
projectId = project.projectId
|
||||
branchId = branch.branchId
|
||||
|
||||
assertProjectNameHasUserSlug :: ProjectName -> Cli ()
|
||||
assertProjectNameHasUserSlug projectName =
|
||||
@ -313,6 +313,6 @@ assertLocalProjectBranchDoesntExist rollback = \case
|
||||
ProjectAndBranch (LocalProjectKey'Project project) branchName -> go project branchName
|
||||
where
|
||||
go project branchName = do
|
||||
Queries.projectBranchExistsByName (project ^. #projectId) branchName & onTrueM do
|
||||
rollback (Output.ProjectAndBranchNameAlreadyExists (ProjectAndBranch (project ^. #name) branchName))
|
||||
Queries.projectBranchExistsByName project.projectId branchName & onTrueM do
|
||||
rollback (Output.ProjectAndBranchNameAlreadyExists (ProjectAndBranch project.name branchName))
|
||||
pure (Right project)
|
||||
|
@ -114,8 +114,7 @@ projectCreate tryDownloadingBase maybeProjectName = do
|
||||
Share.GetProjectBranchResponseBranchNotFound -> done Nothing
|
||||
Share.GetProjectBranchResponseProjectNotFound -> done Nothing
|
||||
Share.GetProjectBranchResponseSuccess branch -> pure branch
|
||||
let useSquashed = False
|
||||
downloadProjectBranchFromShare useSquashed baseLatestReleaseBranch
|
||||
downloadProjectBranchFromShare Share.NoSquashedHead baseLatestReleaseBranch
|
||||
& onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
Cli.Env {codebase} <- ask
|
||||
baseLatestReleaseBranchObject <-
|
||||
|
@ -40,7 +40,6 @@ import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.Verbosity qualified as Verbosity
|
||||
import Unison.CommandLine.InputPattern qualified as InputPattern
|
||||
import Unison.CommandLine.InputPatterns qualified as InputPatterns
|
||||
import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectBranchNameOrLatestRelease (..), ProjectName)
|
||||
@ -67,7 +66,13 @@ handlePull unresolvedSourceAndTarget pullMode verbosity = do
|
||||
& onLeftM (Cli.returnEarly . Output.GitError)
|
||||
ReadShare'LooseCode repo -> downloadLooseCodeFromShare repo & onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
ReadShare'ProjectBranch remoteBranch ->
|
||||
downloadProjectBranchFromShare (pullMode == Input.PullWithoutHistory) remoteBranch & onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
downloadProjectBranchFromShare
|
||||
( case pullMode of
|
||||
Input.PullWithHistory -> Share.NoSquashedHead
|
||||
Input.PullWithoutHistory -> Share.IncludeSquashedHead
|
||||
)
|
||||
remoteBranch
|
||||
& onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
liftIO (Codebase.expectBranchForHash codebase causalHash)
|
||||
when (Branch.isEmpty0 (Branch.head remoteBranchObject)) do
|
||||
Cli.respond (PulledEmptyBranch source)
|
||||
@ -176,7 +181,12 @@ resolveExplicitSource includeSquashed = \case
|
||||
Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case
|
||||
Just (remoteProjectId, _maybeProjectBranchId) -> do
|
||||
remoteProjectName <- Cli.runTransaction (Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri)
|
||||
remoteBranchName <- resolveRemoteBranchName remoteProjectName branchNameOrLatestRelease
|
||||
remoteBranchName <-
|
||||
case branchNameOrLatestRelease of
|
||||
ProjectBranchNameOrLatestRelease'Name name -> pure name
|
||||
ProjectBranchNameOrLatestRelease'LatestRelease -> do
|
||||
remoteProject <- ProjectUtils.expectRemoteProjectById remoteProjectId remoteProjectName
|
||||
ProjectUtils.expectLatestReleaseBranchName remoteProject
|
||||
remoteProjectBranch <-
|
||||
ProjectUtils.expectRemoteProjectBranchByName
|
||||
includeSquashed
|
||||
@ -190,21 +200,15 @@ resolveExplicitSource includeSquashed = \case
|
||||
ReadShare'ProjectBranch (These projectName branchNameOrLatestRelease) -> do
|
||||
remoteProject <- ProjectUtils.expectRemoteProjectByName projectName
|
||||
let remoteProjectId = remoteProject ^. #projectId
|
||||
branchName <- resolveRemoteBranchName projectName branchNameOrLatestRelease
|
||||
branchName <-
|
||||
case branchNameOrLatestRelease of
|
||||
ProjectBranchNameOrLatestRelease'Name name -> pure name
|
||||
ProjectBranchNameOrLatestRelease'LatestRelease -> ProjectUtils.expectLatestReleaseBranchName remoteProject
|
||||
remoteProjectBranch <-
|
||||
ProjectUtils.expectRemoteProjectBranchByName
|
||||
includeSquashed
|
||||
(ProjectAndBranch (remoteProjectId, projectName) branchName)
|
||||
pure (ReadShare'ProjectBranch remoteProjectBranch)
|
||||
where
|
||||
resolveRemoteBranchName :: ProjectName -> ProjectBranchNameOrLatestRelease -> Cli ProjectBranchName
|
||||
resolveRemoteBranchName projectName = \case
|
||||
ProjectBranchNameOrLatestRelease'Name branchName -> pure branchName
|
||||
ProjectBranchNameOrLatestRelease'LatestRelease -> do
|
||||
remoteProject <- ProjectUtils.expectRemoteProjectByName projectName
|
||||
case remoteProject ^. #latestRelease of
|
||||
Nothing -> Cli.returnEarly (Output.ProjectHasNoReleases projectName)
|
||||
Just semver -> pure (UnsafeProjectBranchName ("releases/" <> into @Text semver))
|
||||
|
||||
resolveImplicitTarget :: Cli (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
|
||||
resolveImplicitTarget =
|
||||
|
@ -241,6 +241,7 @@ data Input
|
||||
| ReleaseDraftI Semver
|
||||
| UpgradeI !NameSegment !NameSegment
|
||||
| EditNamespaceI [Path.Path]
|
||||
| LibInstallI !(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease))
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | The source of a `branch` command: what to make the new branch from.
|
||||
|
@ -395,6 +395,7 @@ data Output
|
||||
| UpgradeFailure !FilePath !NameSegment !NameSegment
|
||||
| UpgradeSuccess !NameSegment !NameSegment
|
||||
| LooseCodePushDeprecated
|
||||
| InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment
|
||||
|
||||
data UpdateOrUpgrade = UOUUpdate | UOUUpgrade
|
||||
|
||||
@ -624,6 +625,7 @@ isFailure o = case o of
|
||||
UpgradeFailure {} -> True
|
||||
UpgradeSuccess {} -> False
|
||||
LooseCodePushDeprecated -> True
|
||||
InstalledLibdep {} -> False
|
||||
|
||||
isNumberedFailure :: NumberedOutput -> Bool
|
||||
isNumberedFailure = \case
|
||||
|
@ -56,7 +56,15 @@ import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectBranchNameOrLatestRelease (..), ProjectBranchSpecifier (..), ProjectName, Semver)
|
||||
import Unison.Project
|
||||
( ProjectAndBranch (..),
|
||||
ProjectAndBranchNames (..),
|
||||
ProjectBranchName,
|
||||
ProjectBranchNameOrLatestRelease (..),
|
||||
ProjectBranchSpecifier (..),
|
||||
ProjectName,
|
||||
Semver,
|
||||
)
|
||||
import Unison.Project.Util (ProjectContext (..), projectContextFromPath)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (parseText)
|
||||
import Unison.Syntax.Name qualified as Name (parseText, unsafeParseText)
|
||||
@ -1222,6 +1230,28 @@ forkLocal =
|
||||
pure $ Input.ForkLocalBranchI src dest
|
||||
_ -> Left (I.help forkLocal)
|
||||
|
||||
libInstallInputPattern :: InputPattern
|
||||
libInstallInputPattern =
|
||||
InputPattern
|
||||
{ patternName = "lib.install",
|
||||
aliases = ["install.lib"],
|
||||
visibility = I.Visible,
|
||||
args = [],
|
||||
help =
|
||||
P.wrapColumn2
|
||||
[ ( makeExample libInstallInputPattern ["@unison/base/releases/latest"],
|
||||
"installs `@unison/base/releases/latest` as a dependency of the current project"
|
||||
)
|
||||
],
|
||||
parse = \args ->
|
||||
maybe (Left (I.help libInstallInputPattern)) Right do
|
||||
[arg] <- Just args
|
||||
libdep <-
|
||||
eitherToMaybe $
|
||||
tryInto @(ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) (Text.pack arg)
|
||||
Just (Input.LibInstallI libdep)
|
||||
}
|
||||
|
||||
reset :: InputPattern
|
||||
reset =
|
||||
InputPattern
|
||||
@ -3008,6 +3038,7 @@ validInputs =
|
||||
history,
|
||||
ioTest,
|
||||
ioTestAll,
|
||||
libInstallInputPattern,
|
||||
load,
|
||||
makeStandalone,
|
||||
mergeBuiltins,
|
||||
|
@ -2214,6 +2214,12 @@ notifyUser dir = \case
|
||||
"",
|
||||
"Your non-project code is still available to pull from Share, and you can pull it into a local namespace using `pull myhandle.public`"
|
||||
]
|
||||
InstalledLibdep libdep segment ->
|
||||
pure . P.wrap $
|
||||
"I installed"
|
||||
<> prettyProjectAndBranchName libdep
|
||||
<> "as"
|
||||
<> P.group (P.text (NameSegment.toEscapedText segment) <> ".")
|
||||
|
||||
expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty
|
||||
expectedEmptyPushDest namespace =
|
||||
|
@ -61,6 +61,7 @@ library
|
||||
Unison.Codebase.Editor.HandleInput.EditNamespace
|
||||
Unison.Codebase.Editor.HandleInput.FindAndReplace
|
||||
Unison.Codebase.Editor.HandleInput.FormatFile
|
||||
Unison.Codebase.Editor.HandleInput.InstallLib
|
||||
Unison.Codebase.Editor.HandleInput.Load
|
||||
Unison.Codebase.Editor.HandleInput.MoveAll
|
||||
Unison.Codebase.Editor.HandleInput.MoveBranch
|
||||
|
@ -7,6 +7,7 @@
|
||||
module Unison.Project
|
||||
( ProjectName,
|
||||
projectNameUserSlug,
|
||||
projectNameToUserProjectSlugs,
|
||||
prependUserSlugToProjectName,
|
||||
ProjectBranchName,
|
||||
projectBranchNameUserSlug,
|
||||
@ -82,6 +83,21 @@ projectNameUserSlug (UnsafeProjectName projectName) =
|
||||
then Just (Text.takeWhile (/= '/') (Text.drop 1 projectName))
|
||||
else Nothing
|
||||
|
||||
-- | Parse a "@arya/lens" into the "arya" and "lens" parts.
|
||||
--
|
||||
-- If there's no "arya" part, returns the empty string there.
|
||||
--
|
||||
-- >>> projectNameToUserProjectSlugs (UnsafeProjectName "@arya/lens")
|
||||
-- ("arya","lens")
|
||||
--
|
||||
-- >>> projectNameToUserProjectSlugs (UnsafeProjectName "lens")
|
||||
-- ("","lens")
|
||||
projectNameToUserProjectSlugs :: ProjectName -> (Text, Text)
|
||||
projectNameToUserProjectSlugs (UnsafeProjectName name) =
|
||||
case Text.span (/= '/') name of
|
||||
(project, "") -> ("", project)
|
||||
(atUser, slashProject) -> (Text.drop 1 atUser, Text.drop 1 slashProject)
|
||||
|
||||
-- | Prepend a user slug to a project name, if it doesn't already have one.
|
||||
--
|
||||
-- >>> prependUserSlugToProjectName "arya" "lens"
|
||||
@ -289,6 +305,15 @@ data ProjectBranchSpecifier :: Type -> Type where
|
||||
-- | By name, or "the latest release"
|
||||
ProjectBranchSpecifier'NameOrLatestRelease :: ProjectBranchSpecifier ProjectBranchNameOrLatestRelease
|
||||
|
||||
projectBranchSpecifierParser :: ProjectBranchSpecifier branch -> Megaparsec.Parsec Void Text branch
|
||||
projectBranchSpecifierParser = \case
|
||||
ProjectBranchSpecifier'Name -> projectBranchNameParser False
|
||||
ProjectBranchSpecifier'NameOrLatestRelease ->
|
||||
asum
|
||||
[ ProjectBranchNameOrLatestRelease'LatestRelease <$ "releases/latest",
|
||||
ProjectBranchNameOrLatestRelease'Name <$> projectBranchNameParser False
|
||||
]
|
||||
|
||||
instance From (ProjectAndBranch ProjectName ProjectBranchName) Text where
|
||||
from (ProjectAndBranch project branch) =
|
||||
Text.Builder.run $
|
||||
@ -377,25 +402,15 @@ projectAndBranchNamesParser specifier = do
|
||||
optional projectNameParser >>= \case
|
||||
Nothing -> do
|
||||
_ <- Megaparsec.char '/'
|
||||
branch <- branchParser
|
||||
branch <- projectBranchSpecifierParser specifier
|
||||
pure (That branch)
|
||||
Just (project, hasTrailingSlash) ->
|
||||
if hasTrailingSlash
|
||||
then do
|
||||
optional branchParser <&> \case
|
||||
optional (projectBranchSpecifierParser specifier) <&> \case
|
||||
Nothing -> This project
|
||||
Just branch -> These project branch
|
||||
else pure (This project)
|
||||
where
|
||||
branchParser :: Megaparsec.Parsec Void Text branch
|
||||
branchParser =
|
||||
case specifier of
|
||||
ProjectBranchSpecifier'Name -> projectBranchNameParser False
|
||||
ProjectBranchSpecifier'NameOrLatestRelease ->
|
||||
asum
|
||||
[ ProjectBranchNameOrLatestRelease'LatestRelease <$ "releases/latest",
|
||||
ProjectBranchNameOrLatestRelease'Name <$> projectBranchNameParser False
|
||||
]
|
||||
|
||||
-- | @project/branch@ syntax, where the branch is optional.
|
||||
instance From (ProjectAndBranch ProjectName (Maybe ProjectBranchName)) Text where
|
||||
@ -409,25 +424,34 @@ instance From (ProjectAndBranch ProjectName (Maybe ProjectBranchName)) Text wher
|
||||
|
||||
instance TryFrom Text (ProjectAndBranch ProjectName (Maybe ProjectBranchName)) where
|
||||
tryFrom =
|
||||
maybeTryFrom (Megaparsec.parseMaybe projectWithOptionalBranchParser)
|
||||
maybeTryFrom (Megaparsec.parseMaybe (projectAndOptionalBranchParser ProjectBranchSpecifier'Name))
|
||||
|
||||
-- | Attempt to parse a project and branch name from a string where both are required.
|
||||
instance TryFrom Text (ProjectAndBranch ProjectName ProjectBranchName) where
|
||||
tryFrom =
|
||||
maybeTryFrom $ \txt -> do
|
||||
ProjectAndBranch projectName mayBranchName <- Megaparsec.parseMaybe projectWithOptionalBranchParser txt
|
||||
ProjectAndBranch projectName mayBranchName <- Megaparsec.parseMaybe (projectAndOptionalBranchParser ProjectBranchSpecifier'Name) txt
|
||||
ProjectAndBranch projectName <$> mayBranchName
|
||||
|
||||
instance TryFrom Text (ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) where
|
||||
tryFrom =
|
||||
maybeTryFrom (Megaparsec.parseMaybe (projectAndOptionalBranchParser ProjectBranchSpecifier'NameOrLatestRelease))
|
||||
|
||||
-- Valid things:
|
||||
--
|
||||
-- 1. project
|
||||
-- 2. project/
|
||||
-- 3. project/branch
|
||||
projectWithOptionalBranchParser :: Megaparsec.Parsec Void Text (ProjectAndBranch ProjectName (Maybe ProjectBranchName))
|
||||
projectWithOptionalBranchParser = do
|
||||
projectAndOptionalBranchParser ::
|
||||
forall branch.
|
||||
ProjectBranchSpecifier branch ->
|
||||
Megaparsec.Parsec Void Text (ProjectAndBranch ProjectName (Maybe branch))
|
||||
projectAndOptionalBranchParser specifier = do
|
||||
(project, hasTrailingSlash) <- projectNameParser
|
||||
branch <- if hasTrailingSlash then optional (projectBranchNameParser False) else pure Nothing
|
||||
pure (ProjectAndBranch project branch)
|
||||
fmap (ProjectAndBranch project) $
|
||||
if hasTrailingSlash
|
||||
then optional (projectBranchSpecifierParser specifier)
|
||||
else pure Nothing
|
||||
|
||||
-- | @project/branch@ syntax, where the project is optional. The branch can optionally be preceded by a forward slash.
|
||||
instance From (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) Text where
|
||||
|
Loading…
Reference in New Issue
Block a user