unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-10-26 11:07:48 +03:00
Code Issues Projects Releases Wiki Activity

add lib.install command

Browse Source
This commit is contained in:
Mitchell Rosen 2024-05-15 15:37:10 -04:00
parent 4bd924a0c9
commit 30294bb452
14 changed files with 290 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
unison-cli/src/Unison/Cli/DownloadUtils.hs
View File

@ -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) <-

18
unison-cli/src/Unison/Cli/ProjectUtils.hs
View File

@ -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))

2
unison-cli/src/Unison/Cli/Share/Projects.hs
View File

@ -96,7 +96,7 @@ data GetProjectBranchResponse
data IncludeSquashedHead
= IncludeSquashedHead
| NoSquashedHead
deriving (Show, Eq)
deriving stock (Show, Eq)
-- | Get a project branch by id.
--

3
unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
View File

@ -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
View 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

40
unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs
View File

@ -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)

3
unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs
View File

@ -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 <-

30
unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs
View File

@ -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 =

1
unison-cli/src/Unison/Codebase/Editor/Input.hs
View File

@ -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.

2
unison-cli/src/Unison/Codebase/Editor/Output.hs
View File

@ -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

33
unison-cli/src/Unison/CommandLine/InputPatterns.hs
View File

@ -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,

6
unison-cli/src/Unison/CommandLine/OutputMessages.hs
View File

@ -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 =

1
unison-cli/unison-cli.cabal
View File

@ -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

60
unison-core/src/Unison/Project.hs
View File

@ -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