diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index ce448eda7..284b1ffb0 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -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) <- diff --git a/unison-cli/src/Unison/Cli/ProjectUtils.hs b/unison-cli/src/Unison/Cli/ProjectUtils.hs index 43715e4d7..e4c7b3201 100644 --- a/unison-cli/src/Unison/Cli/ProjectUtils.hs +++ b/unison-cli/src/Unison/Cli/ProjectUtils.hs @@ -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)) diff --git a/unison-cli/src/Unison/Cli/Share/Projects.hs b/unison-cli/src/Unison/Cli/Share/Projects.hs index 2c85cfa85..f2808343e 100644 --- a/unison-cli/src/Unison/Cli/Share/Projects.hs +++ b/unison-cli/src/Unison/Cli/Share/Projects.hs @@ -96,7 +96,7 @@ data GetProjectBranchResponse data IncludeSquashedHead = IncludeSquashedHead | NoSquashedHead - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Get a project branch by id. -- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 453127d03..b15dccf15 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -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 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs new file mode 100644 index 000000000..31ddeb5c1 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs @@ -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 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index 972d160b1..a459b343b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs @@ -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) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index 20e259d89..99a90be6f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs @@ -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 <- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index c2a7a83d2..b67a03cf9 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -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 = diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index dccfbc2a7..8f570f53c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -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. diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 28ec687de..b84a09cd7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -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 diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 1237ffbf5..17549b5d2 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -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, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index f4d1d6fd6..30ef78bd5 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -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 = diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index a6d69888d..7c2b5837e 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -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 diff --git a/unison-core/src/Unison/Project.hs b/unison-core/src/Unison/Project.hs index 155b4a2be..56eb6c55d 100644 --- a/unison-core/src/Unison/Project.hs +++ b/unison-core/src/Unison/Project.hs @@ -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